Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    primarykey
    data
    text
    <p>In Haskell there are many ways to compose computations from components that represent their separate responsibilities. This can be done at the data level with data types and functions (<a href="http://www.haskellforall.com/2012/05/scrap-your-type-classes.html" rel="nofollow">http://www.haskellforall.com/2012/05/scrap-your-type-classes.html</a>) or using type classes. In Haskell you can view every data type, type, function, signature, class, etc as an interface; as long as you have something else of the same type, you can replace a component with something that's compatible.</p> <p>When we want to reason about computations in Haskell we frequently use the abstraction of a <code>Monad</code>. A <code>Monad</code> is an interface for constructing computations. A base computation can be constructed with <code>return</code> and these can be composed together with functions that produce other computations with <code>&gt;&gt;=</code>. When we want to add multiple responsibilities to computations represented by monads, we make monad transformers. In the code below, there are four different monad transformers that capture different aspects of a layered system:</p> <p><code>DatabaseT s</code> adds a database with a schema of type <code>s</code>. It handles data <code>Operation</code>s by storing data in or retrieving it from the database. <code>CacheT s</code> intercepts data <code>Operation</code>s for a schema <code>s</code> and retrieves data from memory, if it is available. <code>OpperationLoggerT</code> logs the <code>Operation</code>s to standard output <code>ResultLoggerT</code> logs the results of <code>Operation</code>s to standard output</p> <p>These four components communicate together using a type class (interface) called <code>MonadOperation s</code>, which requires that components that implement it provide a way to <code>perform</code> an <code>Operation</code> and return its result.</p> <p>This same type class described what is required to use the <code>MonadOperation s</code> system. It requires that someone using the interface provide implementations of type classes that the database and cache will rely on. There are also two data types that are part of this interface, <code>Operation</code> and <code>CRUD</code>. Notice that the interface doesn't need to know anything about the domain objects or database schema, nor does it need to know about the different monad transformers that will implement it. The monad transformers don't know anything about the schema or domain objects, and the domain objects and example code don't know anything about the monad transformers that build the system.</p> <p>The only thing the example code knows is that it will have access to a <code>MonadOperation s</code> due to its type <code>example :: (MonadOperation TableName m) =&gt; m ()</code>.</p> <p>The program <code>main</code> runs the example twice in two different contexts. The first time, the program talks to the database, with its <code>Operations</code> and responses being logged to standard out.</p> <pre><code>Running example program once with an empty database Operation Articles (Create (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."})) ArticleId 0 Operation Articles (Read (ArticleId 0)) Just (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."}) Operation Articles (Read (ArticleId 0)) Just (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."}) </code></pre> <p>The second run logs the responses the program receives, passes <code>Operation</code>s through the cache, and logs the requests before they reach the database. Due to the new caching, which is transparent to the program, the requests to read the article never happen, but the program still receives a response:</p> <pre><code>Running example program once with an empty cache and an empty database Operation Articles (Create (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."})) ArticleId 0 Just (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."}) Just (Article {title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet."}) </code></pre> <p>Here's the entire source code. You should think of it as four independent pieces of code: A program written for our domain, starting at <code>example</code>. An application that is the complete assembly of the program, the domain of discourse, and the various tools that build it, starting at <code>main</code>. The next two sections, ending with the schema <code>TableName</code>, describe a domain of blog posts; their only purpose is to illustrate how the other components go together, not to serve as an example for how to design data structures in Haskell. The next section describes a small interface by which components could communicate about data; it's not necessarily a good interface. Finally, the remainder of the source code implements the loggers, database, and caches that are composed together to form the application. In order to decouple the tools and interface from the domain, there are some somewhat hideous tricks with typeable and dynamics in here, this isn't meant to demonstrate a good way to handle casting and generics either.</p> <pre><code>{-# LANGUAGE StandaloneDeriving, GADTs, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, KindSignatures, FunctionalDependencies, UndecidableInstances #-} module Main ( main ) where import Data.Typeable import qualified Data.Map as Map import Control.Monad.State import Control.Monad.State.Class import Control.Monad.Trans import Data.Dynamic -- Example example :: (MonadOperation TableName m) =&gt; m () example = do id &lt;- perform $ Operation Articles $ Create $ Article { title = "My first article", author = "Cirdec", contents = "Lorem ipsum dolor sit amet." } perform $ Operation Articles $ Read id perform $ Operation Articles $ Read id cid &lt;- perform $ Operation Comments $ Create $ Comment { article = id, user = "Cirdec", comment = "Commenting on my own article!" } perform $ Operation Equality $ Create False perform $ Operation Equality $ Create True perform $ Operation Inequality $ Create True perform $ Operation Inequality $ Create False perform $ Operation Articles $ List perform $ Operation Comments $ List perform $ Operation Equality $ List perform $ Operation Inequality $ List return () -- Run the example twice, changing the cache transparently to the code main :: IO () main = do putStrLn "Running example program once with an empty database" runDatabaseT (runOpperationLoggerT (runResultLoggerT example)) Types { types = Map.empty } putStrLn "\nRunning example program once with an empty cache and an empty database" runDatabaseT (runOpperationLoggerT (runCacheT (runResultLoggerT example) Types { types = Map.empty })) Types { types = Map.empty } return () -- Domain objects data Article = Article { title :: String, author :: String, contents :: String } deriving instance Eq Article deriving instance Ord Article deriving instance Show Article deriving instance Typeable Article newtype ArticleId = ArticleId Int deriving instance Eq ArticleId deriving instance Ord ArticleId deriving instance Show ArticleId deriving instance Typeable ArticleId deriving instance Enum ArticleId data Comment = Comment { article :: ArticleId, user :: String, comment :: String } deriving instance Eq Comment deriving instance Ord Comment deriving instance Show Comment deriving instance Typeable Comment newtype CommentId = CommentId Int deriving instance Eq CommentId deriving instance Ord CommentId deriving instance Show CommentId deriving instance Typeable CommentId deriving instance Enum CommentId -- Database Schema data TableName k v where Articles :: TableName ArticleId Article Comments :: TableName CommentId Comment Equality :: TableName Bool Bool Inequality :: TableName Bool Bool deriving instance Eq (TableName k v) deriving instance Ord (TableName k v) deriving instance Show (TableName k v) deriving instance Typeable2 TableName -- Data interface (Persistance library types) data CRUD k v r where Create :: v -&gt; CRUD k v k Read :: k -&gt; CRUD k v (Maybe v) List :: CRUD k v [(k,v)] Update :: k -&gt; v -&gt; CRUD k v (Maybe ()) Delete :: k -&gt; CRUD k v (Maybe ()) deriving instance (Eq k, Eq v) =&gt; Eq (CRUD k v r) deriving instance (Ord k, Ord v) =&gt; Ord (CRUD k v r) deriving instance (Show k, Show v) =&gt; Show (CRUD k v r) data Operation s t k v r where Operation :: t ~ s k v =&gt; t -&gt; CRUD k v r -&gt; Operation s t k v r deriving instance (Eq (s k v), Eq k, Eq v) =&gt; Eq (Operation s t k v r) deriving instance (Ord (s k v), Ord k, Ord v) =&gt; Ord (Operation s t k v r) deriving instance (Show (s k v), Show k, Show v) =&gt; Show (Operation s t k v r) class (Monad m) =&gt; MonadOperation s m | m -&gt; s where perform :: (Typeable2 s, Typeable k, Typeable v, t ~ s k v, Show t, Ord v, Ord k, Enum k, Show k, Show v, Show r) =&gt; Operation s t k v r -&gt; m r -- Database implementation data Tables t k v = Tables { tables :: Map.Map String (Map.Map k v) } deriving instance Typeable3 Tables emptyTablesFor :: Operation s t k v r -&gt; Tables t k v emptyTablesFor _ = Tables {tables = Map.empty} data Types = Types { types :: Map.Map TypeRep Dynamic } -- Database emulator mapOperation :: (Enum k, Ord k, MonadState (Map.Map k v) m) =&gt; (CRUD k v r) -&gt; m r mapOperation (Create value) = do current &lt;- get let id = case Map.null current of True -&gt; toEnum 0 _ -&gt; succ maxId where (maxId, _) = Map.findMax current put (Map.insert id value current) return id mapOperation (Read key) = do current &lt;- get return (Map.lookup key current) mapOperation List = do current &lt;- get return (Map.toList current) mapOperation (Update key value) = do current &lt;- get case (Map.member key current) of True -&gt; do put (Map.update (\_ -&gt; Just value) key current) return (Just ()) _ -&gt; return Nothing mapOperation (Delete key) = do current &lt;- get case (Map.member key current) of True -&gt; do put (Map.delete key current) return (Just ()) _ -&gt; return Nothing tableOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, MonadState (Tables t k v) m) =&gt; Operation s t k v r -&gt; m r tableOperation (Operation tableName op) = do current &lt;- get let currentTables = tables current let tableKey = show tableName let table = Map.findWithDefault (Map.empty) tableKey currentTables let (result,newState) = runState (mapOperation op) table put Tables { tables = Map.insert tableKey newState currentTables } return result typeOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, Typeable2 s, Typeable k, Typeable v, MonadState Types m) =&gt; Operation s t k v r -&gt; m r typeOperation op = do current &lt;- get let currentTypes = types current let empty = emptyTablesFor op let typeKey = typeOf (empty) let typeMap = fromDyn (Map.findWithDefault (toDyn empty) typeKey currentTypes) empty let (result, newState) = runState (tableOperation op) typeMap put Types { types = Map.insert typeKey (toDyn newState) currentTypes } return result -- Database monad transformer (clone of StateT) newtype DatabaseT (s :: * -&gt; * -&gt; *) m a = DatabaseT { databaseStateT :: StateT Types m a } runDatabaseT :: DatabaseT s m a -&gt; Types -&gt; m (a, Types) runDatabaseT = runStateT . databaseStateT instance (Monad m) =&gt; Monad (DatabaseT s m) where return = DatabaseT . return (DatabaseT m) &gt;&gt;= k = DatabaseT (m &gt;&gt;= \x -&gt; databaseStateT (k x)) instance MonadTrans (DatabaseT s) where lift = DatabaseT . lift instance (MonadIO m) =&gt; MonadIO (DatabaseT s m) where liftIO = DatabaseT . liftIO instance (Monad m) =&gt; MonadOperation s (DatabaseT s m) where perform = DatabaseT . typeOperation -- State monad transformer can preserve operations instance (MonadOperation s m) =&gt; MonadOperation s (StateT state m) where perform = lift . perform -- Cache implementation (very similar to emulated database) cacheMapOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, Show k, Show v, Typeable2 s, Typeable k, Typeable v, MonadState (Map.Map k v) m, MonadOperation s m) =&gt; Operation s t k v r -&gt; m r cacheMapOperation op@(Operation _ (Create value)) = do key &lt;- perform op modify (Map.insert key value) return key cacheMapOperation op@(Operation _ (Read key)) = do current &lt;- get case (Map.lookup key current) of Just value -&gt; return (Just value) _ -&gt; do value &lt;- perform op modify (Map.update (\_ -&gt; value) key) return value cacheMapOperation op@(Operation _ (List)) = do values &lt;- perform op modify (Map.union (Map.fromList values)) current &lt;- get return (Map.toList current) cacheMapOperation op@(Operation _ (Update key value)) = do successful &lt;- perform op modify (Map.update (\_ -&gt; (successful &gt;&gt;= (\_ -&gt; Just value))) key) return successful cacheMapOperation op@(Operation _ (Delete key)) = do result &lt;- perform op modify (Map.delete key) return result cacheTableOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, Show k, Show v, Typeable2 s, Typeable k, Typeable v, MonadState (Tables t k v) m, MonadOperation s m) =&gt; Operation s t k v r -&gt; m r cacheTableOperation op@(Operation tableName _) = do current &lt;- get let currentTables = tables current let tableKey = show tableName let table = Map.findWithDefault (Map.empty) tableKey currentTables (result,newState) &lt;- runStateT (cacheMapOperation op) table put Tables { tables = Map.insert tableKey newState currentTables } return result cacheTypeOperation :: (Enum k, Ord k, Ord v, t ~ s k v, Show t, Show k, Show v, Typeable2 s, Typeable k, Typeable v, MonadState Types m, MonadOperation s m) =&gt; Operation s t k v r -&gt; m r cacheTypeOperation op = do current &lt;- get let currentTypes = types current let empty = emptyTablesFor op let typeKey = typeOf (empty) let typeMap = fromDyn (Map.findWithDefault (toDyn empty) typeKey currentTypes) empty (result, newState) &lt;- runStateT (cacheTableOperation op) typeMap put Types { types = Map.insert typeKey (toDyn newState) currentTypes } return result -- Cache monad transformer newtype CacheT (s :: * -&gt; * -&gt; *) m a = CacheT { cacheStateT :: StateT Types m a } runCacheT :: CacheT s m a -&gt; Types -&gt; m (a, Types) runCacheT = runStateT . cacheStateT instance (Monad m) =&gt; Monad (CacheT s m) where return = CacheT . return (CacheT m) &gt;&gt;= k = CacheT (m &gt;&gt;= \x -&gt; cacheStateT (k x)) instance MonadTrans (CacheT s) where lift = CacheT . lift instance (MonadIO m) =&gt; MonadIO (CacheT s m) where liftIO = CacheT . liftIO instance (Monad m, MonadOperation s m) =&gt; MonadOperation s (CacheT s m) where perform = CacheT . cacheTypeOperation -- Logger monad transform newtype OpperationLoggerT m a = OpperationLoggerT { runOpperationLoggerT :: m a } instance (Monad m) =&gt; Monad (OpperationLoggerT m) where return = OpperationLoggerT . return (OpperationLoggerT m) &gt;&gt;= k = OpperationLoggerT (m &gt;&gt;= \x -&gt; runOpperationLoggerT (k x)) instance MonadTrans (OpperationLoggerT) where lift = OpperationLoggerT instance (MonadIO m) =&gt; MonadIO (OpperationLoggerT m) where liftIO = OpperationLoggerT . liftIO instance (MonadOperation s m, MonadIO m) =&gt; MonadOperation s (OpperationLoggerT m) where perform op = do liftIO $ putStrLn $ show op lift (perform op) -- Result logger newtype ResultLoggerT m a = ResultLoggerT { runResultLoggerT :: m a } instance (Monad m) =&gt; Monad (ResultLoggerT m) where return = ResultLoggerT . return (ResultLoggerT m) &gt;&gt;= k = ResultLoggerT (m &gt;&gt;= \x -&gt; runResultLoggerT (k x)) instance MonadTrans (ResultLoggerT) where lift = ResultLoggerT instance (MonadIO m) =&gt; MonadIO (ResultLoggerT m) where liftIO = ResultLoggerT . liftIO instance (MonadOperation s m, MonadIO m) =&gt; MonadOperation s (ResultLoggerT m) where perform op = do result &lt;- lift (perform op) liftIO $ putStrLn $ "\t" ++ (show result) return result </code></pre> <p>To build this example, you'll need the <code>mtl</code> and <code>containers</code> libraries.</p>
    singulars
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. VO
      singulars
      1. This table or related slice is empty.
    2. VO
      singulars
      1. This table or related slice is empty.
    3. VO
      singulars
      1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload