diff --git a/.gitignore b/.gitignore index 6c392f0..efd3e01 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ .stack-work/* +.vscode diff --git a/README.md b/README.md index 65ff906..8ed57e9 100644 --- a/README.md +++ b/README.md @@ -22,6 +22,7 @@ This repository contains 4 implementations of the program described above, each - A standard [monad transformer stack](https://github.com/stepchowfun/effects/blob/master/src/MonadTransformers.hs) - A [free monad](https://github.com/stepchowfun/effects/blob/master/src/FreeMonad.hs) - The [`Eff` monad](https://github.com/stepchowfun/effects/blob/master/src/ExtensibleEffects.hs) from the "extensible effects" framework +- A [Registry](https://github.com/etorreborre/effects/blob/master/src/Modules.hs) using the [`registry`](https://github.com/etorreborre/registry) library ## Instructions diff --git a/app/Main.hs b/app/Main.hs index 1dd4e85..5b1fe70 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,6 +6,7 @@ import qualified BespokeMonad import qualified ExtensibleEffects import qualified FreeMonad import qualified MonadTransformers +import qualified Modules main :: IO () main = do @@ -17,3 +18,5 @@ main = do putStrLn . snd $ FreeMonad.interpret FreeMonad.program putStrLn "Monad transformers:\n" putStrLn . snd $ MonadTransformers.interpret MonadTransformers.program + putStrLn "Modules:\n" + Modules.app >>= Modules.run diff --git a/effects.cabal b/effects.cabal index 79c6b8b..f04f930 100644 --- a/effects.cabal +++ b/effects.cabal @@ -18,19 +18,25 @@ library exposed-modules: BespokeMonad , ExtensibleEffects , FreeMonad + , Modules + , ModulesPure , MonadTransformers build-depends: MonadRandom , base >= 4.7 && < 5 , extensible-effects , free , mtl + , protolude , random + , registry default-language: Haskell2010 + ghc-options: -fhide-source-paths + executable effects-exe hs-source-dirs: app main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N -fhide-source-paths build-depends: base , effects default-language: Haskell2010 @@ -52,7 +58,7 @@ test-suite effects-test , hspec-core , mtl , random - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N -fhide-source-paths default-language: Haskell2010 source-repository head diff --git a/src/Modules.hs b/src/Modules.hs new file mode 100644 index 0000000..298fa81 --- /dev/null +++ b/src/Modules.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} + +module Modules where + +{- + + Here we describe functionalities with simple datatypes, records of functions, + and call them "modules" + + Then we define "constructors" those modules and specify how they depend on + each other. + + Finally we put them in a "Registry" with the https://github.com/etorreborre/registry + package and wire all of them into a top-level "App" running the whole program using + all the "Modules" + +-} +import Data.IORef +import Data.Registry +import Protolude as P hiding (get) +import System.Random (getStdRandom, randomR) + +-- | Top level application, created from the registry +app :: IO (App IO) +app = make @(IO (App IO)) registry + +registry :: Registry + -- inputs for constructors in the registry + '[IO (Logger IO), IO (Random IO), IO (Accumulator IO)] + -- outputs for constructors in the registry + '[IO (Accumulator IO), IO (Logger IO), IO (Random IO), IO (App IO)] +registry = + fun newAccumulator + +: funTo @IO newLogger + +: funTo @IO newRandom + +: funTo @IO newApp + +: end + +-- * Logging module, can go into its own library + +newtype Logger m = Logger { + info :: forall a . (Show a) => a -> m () +} + +newLogger :: Logger IO +newLogger = Logger P.print + +-- * Random module, implemented using the global random generator +-- for simplicity + +newtype Random m = Random { + draw :: Int -> Int -> m Int +} + +newRandom :: Random IO +newRandom = + Random { + draw = \l h -> getStdRandom (randomR (l, h)) + } + +-- * Accumulator module +-- the constructor for this module is effectful +-- because we instantiate an IORef + +data Accumulator m = Accumulator { + add :: Int -> m () +, get :: m Int +} + +newAccumulator :: IO (Accumulator IO) +newAccumulator = do + counter <- newIORef 0 + pure Accumulator { + add = \n -> modifyIORef counter (+n) + , get = readIORef counter + } + +-- * The top-level app containing the main program +-- It depends on other modules for its implementation + +newtype App m = App { + run :: m () +} + +newApp :: Logger IO -> Random IO -> Accumulator IO -> App IO +newApp Logger{..} Random{..} Accumulator{..} = App { + run = replicateM_ 10 $ + do current <- get + _ <- info current + picked <- draw 0 9 + add picked +} diff --git a/src/ModulesPure.hs b/src/ModulesPure.hs new file mode 100644 index 0000000..cded1d2 --- /dev/null +++ b/src/ModulesPure.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{- + Pure instantiation of the application +-} +module ModulesPure where + +import Control.Monad.Random (Rand, StdGen, getRandomR, mkStdGen, + runRand) +import Control.Monad.State as State (MonadState, StateT, runStateT, get, modify) +import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell) +import Data.Registry +import Modules +import Protolude as P hiding (get) +import System.Random (getStdRandom, randomR) + +-- Pure interface for the components +type P = WriterT String (StateT Int (Rand StdGen)) + +-- | Top level application, created from the registry +appPure :: App P +appPure = make @(App P) registryPure + +registryPure :: Registry + -- inputs for constructors in the registry + '[Logger P, Random P, Accumulator P] + -- outputs for constructors in the registry + '[Accumulator P, Logger P, Random P, App P] +registryPure = + fun newAccumulatorPure + +: fun newLoggerPure + +: fun newRandomPure + +: fun newAppPure + +: end + +newLoggerPure :: Logger P +newLoggerPure = Logger (tell . P.show) + +newRandomPure :: Random P +newRandomPure = + Random { + draw = \l h -> getRandomR (l, h) + } + +newAccumulatorPure :: Accumulator P +newAccumulatorPure = + Accumulator { + add = \n -> State.modify (+n) + , get = State.get + } + +newAppPure :: Logger P -> Random P -> Accumulator P -> App P +newAppPure Logger{..} Random{..} Accumulator{..} = App { + run = replicateM_ 10 $ + do current <- get + _ <- info current + picked <- draw 0 9 + add picked +} diff --git a/stack.yaml b/stack.yaml index 796612b..0db2077 100644 --- a/stack.yaml +++ b/stack.yaml @@ -41,6 +41,7 @@ packages: # (e.g., acme-missiles-0.3) extra-deps: - extensible-effects-3.1.0.0 +- registry-0.1.0.4 # Override default flag values for local packages and extra-deps flags: {}