From 3f6f643633bca12f377076a87f48874a5e377b1a Mon Sep 17 00:00:00 2001 From: thma Date: Sat, 30 Mar 2019 10:48:44 +0100 Subject: [PATCH] finish section on reflection --- LtuPatternFactory.cabal | 2 ++ README.md | 65 ++++++++++++++++++++++++++++++++++------ src/Reflection.hs | 9 ++++-- src/SimplePersistence.hs | 27 ++++++++--------- 4 files changed, 78 insertions(+), 25 deletions(-) diff --git a/LtuPatternFactory.cabal b/LtuPatternFactory.cabal index c05b9ed..15f05ed 100644 --- a/LtuPatternFactory.cabal +++ b/LtuPatternFactory.cabal @@ -21,6 +21,7 @@ executable LtuPatternFactory , Composite , Iterator , JsonPersistence + , SimplePersistence , NullObject , Pipeline , Singleton @@ -65,6 +66,7 @@ test-suite LtuPatternFactory-Demo , Composite , Iterator , JsonPersistence + , SimplePersistence , NullObject , Pipeline , Singleton diff --git a/README.md b/README.md index d85620e..8963e87 100644 --- a/README.md +++ b/README.md @@ -3291,18 +3291,17 @@ module SimplePersistence , persist , retrieve ) where -import Text.Read -- | Identifier for an Entity type Id = String --- | The Entity type class provides generic persistence to JSON files +-- | The Entity type class provides generic persistence to text files class (Show a, Read a) => Entity a where -- | return the unique Id of the entity. This function must be implemented by type class instances. getId :: a -> Id - -- | persist an entity of type a and identified by an Id to a json file + -- | persist an entity of type a and identified by an Id to a text file persist :: a -> IO () persist entity = do -- compute file path based on entity id @@ -3318,13 +3317,10 @@ class (Show a, Read a) => Entity a where -- read file content into string contentString <- readFile fileName -- parse entity from string - let eitherEntity = readEither contentString - case eitherEntity of - Left msg -> fail msg - Right e -> return e + return (read contentString) -- | compute path of data file -getPath :: String -> String +getPath :: String -> FilePath getPath id = ".stack-work/" ++ id ++ ".txt" ``` @@ -3355,7 +3351,58 @@ So all a user has to do in order to use our library is: 2. let the data type derive from `Entity` by providing an implementation for `getId`. 3. use `persist` and `retrieve` to write and read entities to/from file. -to be continued +As we can see from the function signatures for `persist` and `retrieve` both functions have no information about the concrete type they are being used on: + +```haskell +persist :: Entity a => a -> IO () +retrieve :: Entity a => Id -> IO a +``` + +As a consequence the generic implementation of both function in the Entity type class also have no direct access to the concrete type of the processed entities. (They simply delegate to other generic functions like `read` and `show`.) + +So how can we access the concrete type of a processed entity? Imagine we'd like to store our entities into files that bear the type name as part of the file name, e.g. `User.7411.txt` + +The answer is of course: reflection. Here is what we have to add to our library to extend `persist` according to our new requirements: + +```haskell +{-# LANGUAGE ScopedTypeVariables #-} +import Data.Typeable + +class (Show a, Read a, Typeable a) => Entity a where + + -- | persist an entity of type a and identified by an Id to a file + persist :: a -> IO () + persist entity = do + -- compute file path based on entity type and id + let fileName = getPath (typeOf entity) (getId entity) + -- serialize entity as JSON and write to file + writeFile fileName (show entity) + +-- | compute path of data file, this time with the type name as part of the file name +getPath :: TypeRep -> String -> FilePath +getPath tr id = ".stack-work/" ++ show tr ++ "." ++ id ++ ".txt" +``` + +We have to add a new constrained `Typeable a` to our definition of `Entity`. This allows to use reflective code on our entity types. In our case we simply compute a type representation `TypeRep` by calling `typeOf entity` which we then use in `getPath` to add the type name to the file path. + +The definition of `retrieve` is a bit more tricky as we don't yet have an entity available yet when computing the file path. So we have to apply a small trick to compute the correct type representation: + +```haskell + retrieve :: Id -> IO a + retrieve id = do + -- compute file path based on entity type and id + let fileName = getPath (typeOf (undefined :: a)) id + -- read file content into string + contentString <- readFile fileName + -- parse entity from string + return (read contentString) +``` + +The compiler will be able to deduce the correct type of `a` in the expression `(undefined :: a)` as the concrete return type of `retrieve` must be specified at the call site, as in example `user' <- retrieve "1" :: IO User` + +Of course this was only a teaser of what is possible with generic reflective programming. The fearless reader is invited to study the [source code of the aeson library](https://github.com/bos/aeson) for a deep dive. + +[Sourcecode for this section](https://github.com/thma/LtuPatternFactory/blob/master/src/Reflection.hs) ## Conclusions diff --git a/src/Reflection.hs b/src/Reflection.hs index 6126619..245623d 100644 --- a/src/Reflection.hs +++ b/src/Reflection.hs @@ -1,11 +1,16 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} module Reflection where +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics +--import JsonPersistence -- use this to use JSON serialization/deserialization import SimplePersistence (Id, Entity, getId, persist, retrieve) data User = User { userId :: Id , name :: String , email :: String -} deriving (Show, Read) +} deriving (Show, Read, Generic, ToJSON, FromJSON) instance Entity User where getId = userId @@ -14,7 +19,7 @@ data Post = Post { postId :: Id , userRef :: Id , text :: String -} deriving (Show, Read) +} deriving (Show, Read, Generic, ToJSON, FromJSON) instance Entity Post where getId = postId diff --git a/src/SimplePersistence.hs b/src/SimplePersistence.hs index db58f19..4fb825c 100644 --- a/src/SimplePersistence.hs +++ b/src/SimplePersistence.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} module SimplePersistence ( Id , Entity @@ -5,38 +6,36 @@ module SimplePersistence , persist , retrieve ) where -import Text.Read +import Data.Typeable -- | Identifier for an Entity type Id = String --- | The Entity type class provides generic persistence to JSON files -class (Show a, Read a) => Entity a where +-- | The Entity type class provides generic persistence to txt files +class (Show a, Read a, Typeable a) => Entity a where -- | return the unique Id of the entity. This function must be implemented by type class instances. getId :: a -> Id - -- | persist an entity of type a and identified by an Id to a json file + -- | persist an entity of type a and identified by an Id to a file persist :: a -> IO () persist entity = do - -- compute file path based on entity id - let fileName = getPath (getId entity) + -- compute file path based on entity type and id + let fileName = getPath (typeOf entity) (getId entity) -- serialize entity as JSON and write to file writeFile fileName (show entity) -- | load persistent entity of type a and identified by an Id retrieve :: Id -> IO a retrieve id = do - -- compute file path based on entity id - let fileName = getPath id + -- compute file path based on entity type and id + let fileName = getPath (typeOf (undefined :: a)) id -- read file content into string contentString <- readFile fileName -- parse entity from string - let eitherEntity = readEither contentString - case eitherEntity of - Left msg -> fail msg - Right e -> return e + return (read contentString) + -- | compute path of data file -getPath :: String -> String -getPath id = ".stack-work/" ++ id ++ ".txt" \ No newline at end of file +getPath :: TypeRep -> String -> FilePath +getPath tr id = ".stack-work/" ++ show tr ++ "." ++ id ++ ".txt" \ No newline at end of file