diff --git a/LtuPatternFactory.cabal b/LtuPatternFactory.cabal index 9599ed7..c05b9ed 100644 --- a/LtuPatternFactory.cabal +++ b/LtuPatternFactory.cabal @@ -38,6 +38,7 @@ executable LtuPatternFactory , AspectPascal , MiniPascal , HigherOrder + , Reflection main-is: Main.hs default-language: Haskell2010 @@ -81,6 +82,7 @@ test-suite LtuPatternFactory-Demo , AspectPascal , MiniPascal , HigherOrder + , Reflection hs-source-dirs: src main-is: Main.hs diff --git a/src/JsonPersistence.hs b/src/JsonPersistence.hs index 7c50976..33b653f 100644 --- a/src/JsonPersistence.hs +++ b/src/JsonPersistence.hs @@ -1,58 +1,38 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -module JsonPersistence where -import Data.Aeson (FromJSON, ToJSON, eitherDecodeFileStrict, - encodeFile, toJSON) ---import Data.Tagged -import GHC.Generics (Generic) +{-# LANGUAGE ScopedTypeVariables #-} +module JsonPersistence + ( Id + , Entity + , store + , retrieve + ) where +import Data.Aeson (FromJSON, ToJSON, eitherDecodeFileStrict, encodeFile, toJSON) +import Data.Typeable +-- | Identifier for an Entity type Id = String -class (ToJSON a, FromJSON a, Eq a, Show a) => Entity a where - -- | store persistent entity of type a and identified by an Id to a json file +-- | The Entity type class provides generic persistence to JSON files +class (ToJSON a, FromJSON a, Eq a, Show a, Typeable a) => Entity a where + + -- | store entity of type a and identified by an Id to a json file store :: Id -> a -> IO () store id entity = do - -- compute file path based on entity id - let jsonFileName = getPath id + -- compute file path based on concrete type and entity id + let jsonFileName = getPath (typeRep ([] :: [a])) id -- serialize entity as JSON and write to file encodeFile jsonFileName entity - -- | load persistent entity of type a and identified by id + -- | load persistent entity of type a and identified by an Id retrieve :: Id -> IO a retrieve id = do - -- compute file path based on id - let jsonFileName = getPath id + -- compute file path based on entity type and entity id + let jsonFileName = getPath (typeRep ([] :: [a])) id -- parse entity from JSON file eitherEntity <- eitherDecodeFileStrict jsonFileName case eitherEntity of Left msg -> fail msg Right e -> return e - -- | publish an entity (e.g. to a message bus, or just print it out) - publish :: a -> IO () - publish = print - -- | compute path of data file -getPath :: Id -> String -getPath id = ".stack-work/" ++ id ++ ".json" - -data User = User { - name :: String - , email :: String -} deriving (Show, Eq, Generic, ToJSON, FromJSON, Entity) - -data Post = Post { - userId :: Id - , text :: String -} deriving (Show, Eq, Generic, ToJSON, FromJSON, Entity) - -jsonPersistenceDemo = do - putStrLn "JsonPersistence" - let user = User "Heinz Meier" "hm@meier.com" - let post = Post "1" "My name is Heinz, this is my first post" - store "1" user - store "4711" post - user' <- retrieve "1" :: IO User - publish user' - (retrieve "4711" :: IO Post) >>= publish - +getPath :: TypeRep -> String -> String +getPath tr id = ".stack-work/" ++ show tr ++ "." ++ id ++ ".json" \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index 5105638..5ef38ed 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -20,6 +20,7 @@ import Visitor import MapReduce import MiniPascal import AspectPascal +import Reflection main :: IO () main = do @@ -35,7 +36,7 @@ main = do nullObjectDemo iteratorDemo abstractFactoryDemo - jsonPersistenceDemo + reflectionDemo demoDI interpreterDemo infinityDemo diff --git a/src/Reflection.hs b/src/Reflection.hs new file mode 100644 index 0000000..0dc7b88 --- /dev/null +++ b/src/Reflection.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +module Reflection where + +import JsonPersistence (Id, Entity, store, retrieve) +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +data User = User { + name :: String + , email :: String +} deriving (Show, Eq, Generic, ToJSON, FromJSON, Entity) + +data Post = Post { + userId :: Id + , text :: String +} deriving (Show, Eq, Generic, ToJSON, FromJSON, Entity) + +retrieveUser :: Id -> IO User +retrieveUser = retrieve + +retrievePost :: Id -> IO Post +retrievePost = retrieve + +reflectionDemo = do + putStrLn "Reflection" + let user = User "Heinz Meier" "hm@meier.com" + let post = Post "1" "My name is Heinz, this is my first post" + + store "1" user + store "4711" post + + user' <- retrieve "1" :: IO User + user' <- retrieveUser "1" + print user' + + retrievePost "4711" >>= print +