Как получить отражение типа в Хаскеле - PullRequest
Новая
       7

Как получить отражение типа в Хаскеле

0 голосов
/ 27 мая 2018

Я написал простой Сервер Отдыха Yesod, который сохраняет сущности в файлах JSON.Объекты хранятся на диске в файлах с именем data / type.id.json.Например, retrieveCustomer «1234» должен загружать данные из файла data / Customer.1234.json.

Я использую полиморфную функцию retrieveEntity, которая может извлекать экземпляры любого типа данных, которые создают экземпляр класса типов FromJSON.(Эта часть прекрасно работает)

Но на данный момент я должен заполнить имя типа, жестко закодированное в специфических для типа функциях, таких как retrieveCustomer.

Как мне удается динамически вычислить имя типа вуниверсальный retrieveEntity?Я думаю, что в основном ищу механизм отражения типа Хаскелла, с которым я до сих пор не сталкивался? 

-- | 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 Ответ

0 голосов
/ 27 мая 2018

Полагаю, стандартным приемом является использование Typeable, в частности typeOf :: Typeable a => a -> TypeRep.К сожалению, у нас нет a, лежащего вокруг, чтобы вызывать это до тех пор, пока мы не прочитаем файл, что мы не можем сделать, пока у нас не будет правильного имени файла, что мы не можем сделать, пока мы не вызовем typeOf, что мы не можем сделать до тех пор, пока не прочтем файл ...

... или можем? 

{-# 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

Или есть менее изнурительные варианты,например, используя typeRep :: Typeable a => proxy a -> TypeRep.Затем мы можем использовать ScopedTypeVariables, чтобы ввести соответствующий тип в область видимости. 

{-# 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
...