2
votes

I've written a simple Yesod Rest Server that persists entities in JSON files. Entities are stored on disk in files named data/type.id.json. For instance retrieveCustomer "1234" should load data from file data/Customer.1234.json.

I'm using a polymorphic function retrieveEntity that can retrieve instances of any data type that instantiate the FromJSON typeclass. (This part works nicely)

But at the moment I have to fill in the type name hardcoded in type-specific functions like retrieveCustomer.

How do I manage to compute the type name dynamically in the generic retrieveEntity? I think I'm basically looking for a Haskell type reflection mechanism which I did not come across so far?

-- | retrieve a Customer by id
retrieveCustomer :: Text -> IO Customer
retrieveCustomer id = do
    retrieveEntity "Customer" id :: IO Customer

-- | load a persistent entity of type t and identified by id from the backend
retrieveEntity :: (FromJSON a) => String -> Text -> IO a
retrieveEntity t id = do
    let jsonFileName = getPath t id ".json"
    parseFromJsonFile jsonFileName :: FromJSON a => IO a

-- | compute path of data file
getPath :: String -> Text -> String -> String
getPath t id ex = "data/" ++ t ++ "." ++ unpack id ++ ex

-- | read from file fileName and then parse the contents as a FromJSON instance.
parseFromJsonFile :: FromJSON a => FilePath -> IO a
parseFromJsonFile fileName = do
    contentBytes <- B.readFile fileName
    case eitherDecode contentBytes of
        Left msg -> fail msg
        Right x  -> return x
1

1 Answers

0
votes

I guess the standard trick is to use Typeable, specifically typeOf :: Typeable a => a -> TypeRep. Unfortunately, we don't have an a lying around to call this on until after we've read the file, which we can't do until we have the right filename, which we can't do until we call typeOf, which we can't do until after we've read the file...

...or can we?

{-# LANGUAGE RecursiveDo #-}
import Data.Aeson
import Data.Text
import Data.Typeable
import qualified Data.ByteString.Lazy as B

retrieveEntity :: (FromJSON a, Typeable a) => Text -> IO a
retrieveEntity id = mdo
    let jsonFileName = getPath (typeOf result) id ".json"
    result <- parseFromJsonFile jsonFileName
    return result

getPath :: TypeRep -> Text -> String -> String
getPath tr id ex = "data/" ++ show tr ++ "." ++ unpack id ++ ex

parseFromJsonFile :: FromJSON a => FilePath -> IO a
parseFromJsonFile fileName = do
    contentBytes <- B.readFile fileName
    case eitherDecode contentBytes of
        Left msg -> fail msg
        Right x  -> return x

Or there are less mind-bending options, such as using typeRep :: Typeable a => proxy a -> TypeRep. Then we can use ScopedTypeVariables to bring the appropriate type into scope.

{-# LANGUAGE ScopedTypeVariables #-}
import Data.Aeson
import Data.Text
import Data.Typeable
import qualified Data.ByteString.Lazy as B

-- don't forget the forall, it's a STV requirement
retrieveEntity :: forall a. (FromJSON a, Typeable a) => Text -> IO a
retrieveEntity id = do
    let jsonFileName = getPath (typeRep ([] :: [a])) id ".json"
    result <- parseFromJsonFile jsonFileName
    return result

getPath :: TypeRep -> Text -> String -> String
getPath tr id ex = "data/" ++ show tr ++ "." ++ unpack id ++ ex

parseFromJsonFile :: FromJSON a => FilePath -> IO a
parseFromJsonFile fileName = do
    contentBytes <- B.readFile fileName
    case eitherDecode contentBytes of
        Left msg -> fail msg
        Right x  -> return x