module Data.Aeson.Config.FromValue (
FromValue(..)
, Parser
, Result
, decodeValue
, Generic
, GenericDecode
, genericFromValue
, Options(..)
, genericFromValueWith
, typeMismatch
, withObject
, withText
, withString
, withArray
, withNumber
, withBool
, (.:)
, (.:?)
, Value(..)
, Object
, Array
) where
import GHC.Generics
import Control.Monad
import Control.Applicative
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as HashMap
import Data.Aeson.Types (FromJSON(..))
import Data.Aeson.Config.Util
import Data.Aeson.Config.Parser
type Result a = Either String (a, [String])
decodeValue :: FromValue a => Value -> Result a
decodeValue = runParser fromValue
(.:) :: FromValue a => Object -> Text -> Parser a
(.:) = explicitParseField fromValue
(.:?) :: FromValue a => Object -> Text -> Parser (Maybe a)
(.:?) = explicitParseFieldMaybe fromValue
class FromValue a where
fromValue :: Value -> Parser a
default fromValue :: forall d m. (Generic a, Rep a ~ D1 d m, Datatype d, GenericDecode (Rep a)) => Value -> Parser a
fromValue = genericFromValue
genericFromValue :: forall a d m. (Generic a, Rep a ~ D1 d m, Datatype d, GenericDecode (Rep a)) => Value -> Parser a
genericFromValue = genericFromValueWith (Options $ hyphenize name)
where
name :: String
name = datatypeName (undefined :: D1 d m p)
instance FromValue Bool where
fromValue = liftParser . parseJSON
instance FromValue Int where
fromValue = liftParser . parseJSON
instance FromValue Text where
fromValue = liftParser . parseJSON
instance FromValue String where
fromValue = liftParser . parseJSON
instance FromValue a => FromValue (Maybe a) where
fromValue value = liftParser (parseJSON value) >>= traverse fromValue
instance FromValue a => FromValue [a] where
fromValue = withArray $ zipWithM (parseIndexed fromValue) [0..] . V.toList
where
parseIndexed :: (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexed p n value = p value <?> Index n
instance FromValue a => FromValue (Map String a) where
fromValue = withObject $ \ o -> do
xs <- forM (HashMap.toList o) $ \ (name, value) ->
(,) (T.unpack name) <$> fromValue value <?> Key name
return $ Map.fromList xs
instance (FromValue a, FromValue b) => FromValue (a, b) where
fromValue v = (,) <$> fromValue v <*> fromValue v
instance (FromValue a, FromValue b) => FromValue (Either a b) where
fromValue v = Left <$> fromValue v <|> Right <$> fromValue v
data Options = Options {
optionsRecordSelectorModifier :: String -> String
}
genericFromValueWith :: (Generic a, GenericDecode (Rep a)) => Options -> Value -> Parser a
genericFromValueWith opts = fmap to . genericDecode opts
class GenericDecode f where
genericDecode :: Options -> Value -> Parser (f p)
instance (GenericDecode a) => GenericDecode (D1 d a) where
genericDecode opts = fmap M1 . genericDecode opts
instance (GenericDecode a) => GenericDecode (C1 c a) where
genericDecode opts = fmap M1 . genericDecode opts
instance (GenericDecode a, GenericDecode b) => GenericDecode (a :*: b) where
genericDecode opts o = (:*:) <$> genericDecode opts o <*> genericDecode opts o
instance (Selector sel, FromValue a) => GenericDecode (S1 sel (Rec0 a)) where
genericDecode = accessFieldWith (.:)
instance (Selector sel, FromValue a) => GenericDecode (S1 sel (Rec0 (Maybe a))) where
genericDecode = accessFieldWith (.:?)
accessFieldWith :: forall sel a p. Selector sel => (Object -> Text -> Parser a) -> Options -> Value -> Parser (S1 sel (Rec0 a) p)
accessFieldWith op Options{..} v = M1 . K1 <$> withObject (`op` T.pack label) v
where
label = optionsRecordSelectorModifier $ selName (undefined :: S1 sel (Rec0 a) p)