diff --git a/lib/GEODE/Metadata/Work.hs b/lib/GEODE/Metadata/Work.hs index 9c0aa93fb41875768f0e9b736fa5d69c37c8e9f3..68e4117f93e5a355a30cebbf7894a02601f01e33 100644 --- a/lib/GEODE/Metadata/Work.hs +++ b/lib/GEODE/Metadata/Work.hs @@ -1,25 +1,30 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} module GEODE.Metadata.Work ( Work(..) ) where -import Data.Aeson (ToJSON(..)) +import Data.Aeson (FromJSON(..), ToJSON(..), withText) +import Data.ByteString.Char8 as ByteString (unpack) import Data.Csv (FromField(..), ToField(..)) import Data.Char (toLower) -import Data.ByteString.Char8 as ByteString (map) +import Data.Text as Text (unpack) +import GHC.Generics (Generic) -data Work = EDdA | LGE | Wikipedia deriving (Eq, Ord, Read, Show) +data Work = EDdA | LGE | Wikipedia deriving (Eq, Generic, Ord, Show) + +tolerantParser :: (Applicative m, Monoid (m Work)) => String -> m Work +tolerantParser = recognize . fmap toLower + where + recognize "edda" = pure EDdA + recognize "lge" = pure LGE + recognize "wikipedia" = pure Wikipedia + recognize _ = mempty instance FromField Work where - parseField = recognize . ByteString.map toLower - where - recognize "EDdA" = pure EDdA - recognize "LGE" = pure LGE - recognize "Wikipedia" = pure Wikipedia - recognize _ = mempty + parseField = tolerantParser . ByteString.unpack instance ToField Work where toField = toField . show -instance ToJSON Work where - toJSON = toJSON . show - +instance ToJSON Work +instance FromJSON Work where + parseJSON = withText "Work" $ tolerantParser . Text.unpack