{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}

-- | Convert a Haskell value to a (JSON representation of a) Fay value.

module Fay.Convert
  (showToFay
  ,readFromFay
  ,readFromFay'
  ,encodeFay
  ,decodeFay)
  where

import           Fay.Compiler.Prelude

import           Control.Monad.State   (evalStateT, get, lift, put)
import           Control.Spoon
import           Data.Aeson
import           Data.Aeson.Types      (parseEither)
import           Data.Data
import           Data.Generics.Aliases
import           Data.HashMap.Strict   (HashMap)
import qualified Data.HashMap.Strict   as Map
import           Data.Text             (Text)
import qualified Data.Text             as Text
import           Data.Time.Clock       (UTCTime)
import           Data.Vector           (Vector)
import qualified Data.Vector           as Vector

--------------------------------------------------------------------------------
-- The conversion functions.

-- | Convert a Haskell value to a Fay json value.  This can fail when primitive
--   values aren't handled by explicit cases.  'encodeFay' can be used to
--   resolve this issue.
showToFay :: Data a => a -> Maybe Value
showToFay :: a -> Maybe Value
showToFay = Value -> Maybe Value
forall a. NFData a => a -> Maybe a
spoon (Value -> Maybe Value) -> (a -> Value) -> a -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericQ Value -> GenericQ Value) -> GenericQ Value
encodeFay GenericQ Value -> GenericQ Value
forall a. a -> a
id

-- | Convert a Haskell value to a Fay json value.  This can fail when primitive
--   values aren't handled by explicit cases.  When this happens, you can add
--   additional cases via the first parameter.
--
--   The first parameter is a function that can be used to override the
--   conversion.  This usually looks like using 'extQ' to additional type-
--   specific cases.
encodeFay :: (GenericQ Value -> GenericQ Value) -> GenericQ Value
encodeFay :: (GenericQ Value -> GenericQ Value) -> GenericQ Value
encodeFay GenericQ Value -> GenericQ Value
specialCases = GenericQ Value -> GenericQ Value
specialCases (GenericQ Value -> GenericQ Value)
-> GenericQ Value -> GenericQ Value
forall a b. (a -> b) -> a -> b
$
    GenericQ Value -> GenericQ Value
encodeGeneric GenericQ Value
rec
    (a -> Value) -> (() -> Value) -> a -> Value
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` () -> Value
unit
    (a -> Value) -> (Bool -> Value) -> a -> Value
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bool -> Value
Bool
    (a -> Value) -> (Int -> Value) -> a -> Value
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` (Int -> Value
forall a. ToJSON a => a -> Value
toJSON :: Int -> Value)
    (a -> Value) -> (Float -> Value) -> a -> Value
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` (Float -> Value
forall a. ToJSON a => a -> Value
toJSON :: Float -> Value)
    (a -> Value) -> (Double -> Value) -> a -> Value
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` (Double -> Value
forall a. ToJSON a => a -> Value
toJSON :: Double -> Value)
    (a -> Value) -> (UTCTime -> Value) -> a -> Value
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` (UTCTime -> Value
forall a. ToJSON a => a -> Value
toJSON :: UTCTime -> Value)
    (a -> Value) -> (forall e. Data e => [e] -> Value) -> a -> Value
forall d (t :: * -> *) q.
(Data d, Typeable t) =>
(d -> q) -> (forall e. Data e => t e -> q) -> d -> q
`ext1Q` forall e. Data e => [e] -> Value
list
    (a -> Value) -> (String -> Value) -> a -> Value
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` String -> Value
string
    (a -> Value) -> (Char -> Value) -> a -> Value
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Char -> Value
char
    (a -> Value) -> (Text -> Value) -> a -> Value
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Text -> Value
text
  where
    rec :: GenericQ Value
    rec :: a -> Value
rec = (GenericQ Value -> GenericQ Value) -> GenericQ Value
encodeFay GenericQ Value -> GenericQ Value
specialCases
    unit :: () -> Value
unit () = Value
Null
    list :: Data a => [a] -> Value
    list :: [a] -> Value
list = Array -> Value
Array (Array -> Value) -> ([a] -> Array) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Array) -> ([a] -> [Value]) -> [a] -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
GenericQ Value
rec
    string :: String -> Value
string = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
    char :: Char -> Value
char = Text -> Value
String (Text -> Value) -> (Char -> Text) -> Char -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Char -> String) -> Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:[])
    text :: Text -> Value
text = Text -> Value
String

encodeGeneric :: GenericQ Value -> GenericQ Value
encodeGeneric :: GenericQ Value -> GenericQ Value
encodeGeneric GenericQ Value
rec a
x =
    case String
constrName of
      Char
'(':((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') -> String
")") ->
        Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ GenericQ Value -> a -> [Value]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ GenericQ Value
rec a
x
      String
_ -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Text, Value)] -> Object) -> [(Text, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ ((String, Value) -> (Text, Value))
-> [(String, Value)] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text) -> (String, Value) -> (Text, Value)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> Text
Text.pack) [(String, Value)]
fields
  where
    fields :: [(String, Value)]
fields =
      (String
"instance", Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
constrName) (String, Value) -> [(String, Value)] -> [(String, Value)]
forall a. a -> [a] -> [a]
:
      [String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
labels (GenericQ Value -> a -> [Value]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ GenericQ Value
rec a
x)
    constrName :: String
constrName = Constr -> String
showConstr Constr
constr
    constr :: Constr
constr = a -> Constr
forall a. Data a => a -> Constr
toConstr a
x
    -- Note: constrFields can throw errors for non-algebraic datatypes.  These
    -- ought to be taken care of in the other cases of encodeFay.
    labels :: [String]
labels = case Constr -> [String]
constrFields Constr
constr of
      [] -> (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"slot"String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> String
forall a. Show a => a -> String
show) [Int
1::Int ..]
      [String]
ls -> [String]
ls

-- | Convert a Fay json value to a Haskell value.
readFromFay :: Data a => Value -> Maybe a
readFromFay :: Value -> Maybe a
readFromFay = (String -> Maybe a) -> (a -> Maybe a) -> Either String a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Maybe a)
-> (Value -> Either String a) -> Value -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Data a => Value -> Either String a -> Either String a)
-> Value -> Either String a
forall b.
Data b =>
(forall a. Data a => Value -> Either String a -> Either String a)
-> Value -> Either String b
decodeFay ((Either String a -> Either String a)
-> Value -> Either String a -> Either String a
forall a b. a -> b -> a
const Either String a -> Either String a
forall a. a -> a
id)

-- | Convert a Fay json value to a Haskell value.  This is like readFromFay,
--   except it yields helpful error messages on failure.
readFromFay' :: Data a => Value -> Either String a
readFromFay' :: Value -> Either String a
readFromFay' = (forall a. Data a => Value -> Either String a -> Either String a)
-> Value -> Either String a
forall b.
Data b =>
(forall a. Data a => Value -> Either String a -> Either String a)
-> Value -> Either String b
decodeFay ((Either String a -> Either String a)
-> Value -> Either String a -> Either String a
forall a b. a -> b -> a
const Either String a -> Either String a
forall a. a -> a
id)

-- | Convert a Fay json value to a Haskell value.
--
--   The first parameter is a function that can be used to override the
--   conversion.  This usually looks like using 'extR' to additional type-
--   specific cases.
decodeFay :: Data b
          => (forall a. Data a => Value -> Either String a -> Either String a)
          -> Value
          -> Either String b
decodeFay :: (forall a. Data a => Value -> Either String a -> Either String a)
-> Value -> Either String b
decodeFay forall a. Data a => Value -> Either String a -> Either String a
specialCases Value
value = Value -> Either String b -> Either String b
forall a. Data a => Value -> Either String a -> Either String a
specialCases Value
value (Either String b -> Either String b)
-> Either String b -> Either String b
forall a b. (a -> b) -> a -> b
$
    GenericParser -> Value -> Either String b
forall a. Data a => GenericParser -> Value -> Either String a
parseDataOrTuple GenericParser
rec Value
value
    Either String b -> Either String () -> Either String b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
m a -> m b -> m a
`extR` Value -> Either String ()
parseUnit Value
value
    Either String b -> Either String Bool -> Either String b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
m a -> m b -> m a
`extR` Value -> Either String Bool
parseBool Value
value
    Either String b -> Either String Int -> Either String b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
m a -> m b -> m a
`extR` Value -> Either String Int
parseInt Value
value
    Either String b -> Either String Float -> Either String b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
m a -> m b -> m a
`extR` Value -> Either String Float
parseFloat Value
value
    Either String b -> Either String Double -> Either String b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
m a -> m b -> m a
`extR` Value -> Either String Double
parseDouble Value
value
    Either String b
-> (forall e. Data e => Either String [e]) -> Either String b
forall (m :: * -> *) d (t :: * -> *).
(Monad m, Data d, Typeable t) =>
m d -> (forall e. Data e => m (t e)) -> m d
`ext1R` GenericParser -> Value -> Either String [e]
forall a. Data a => GenericParser -> Value -> Either String [a]
parseArray GenericParser
rec Value
value
    Either String b -> Either String UTCTime -> Either String b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
m a -> m b -> m a
`extR` Value -> Either String UTCTime
parseUTCTime Value
value
    Either String b -> Either String String -> Either String b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
m a -> m b -> m a
`extR` Value -> Either String String
parseString Value
value
    Either String b -> Either String Char -> Either String b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
m a -> m b -> m a
`extR` Value -> Either String Char
parseChar Value
value
    Either String b -> Either String Text -> Either String b
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
m a -> m b -> m a
`extR` Value -> Either String Text
parseText Value
value
  where
    rec :: GenericParser
    rec :: Value -> Either String a
rec = (forall a. Data a => Value -> Either String a -> Either String a)
-> Value -> Either String a
forall b.
Data b =>
(forall a. Data a => Value -> Either String a -> Either String a)
-> Value -> Either String b
decodeFay forall a. Data a => Value -> Either String a -> Either String a
specialCases

type GenericParser = forall a. Data a => Value -> Either String a

-- | Parse a data type or record or tuple.
parseDataOrTuple :: forall a. Data a => GenericParser -> Value -> Either String a
parseDataOrTuple :: GenericParser -> Value -> Either String a
parseDataOrTuple GenericParser
rec Value
value = Either String a
result where
  result :: Either String a
result = Value -> Either String a
GenericParser
getAndParse Value
value
  typ :: DataType
typ = a -> DataType
forall a. Data a => a -> DataType
dataTypeOf (a
forall a. HasCallStack => a
undefined :: a)
  getAndParse :: Value -> Either String a
getAndParse Value
x =
    case Value
x of
      Object Object
obj -> GenericParser -> DataType -> Object -> Either String a
forall a.
Data a =>
GenericParser -> DataType -> Object -> Either String a
parseObject GenericParser
rec DataType
typ Object
obj
      Array Array
tuple -> GenericParser -> DataType -> Array -> Either String a
forall a.
Data a =>
GenericParser -> DataType -> Array -> Either String a
parseTuple GenericParser
rec DataType
typ Array
tuple
      Value
_ -> Value -> Either String a
GenericParser
badData Value
value

-- | Parse a tuple.
parseTuple :: Data a => GenericParser -> DataType -> Vector Value -> Either String a
parseTuple :: GenericParser -> DataType -> Array -> Either String a
parseTuple GenericParser
rec DataType
typ Array
arr =
  case DataType -> [Constr]
dataTypeConstrs DataType
typ of
    [Constr
cons] -> StateT [Int] (Either String) a -> [Int] -> Either String a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ((forall d. Data d => StateT [Int] (Either String) d)
-> Constr -> StateT [Int] (Either String) a
forall (m :: * -> *) a.
(Monad m, Data a) =>
(forall d. Data d => m d) -> Constr -> m a
fromConstrM (do ~(Int
i:[Int]
next) <- StateT [Int] (Either String) [Int]
forall s (m :: * -> *). MonadState s m => m s
get
                                          [Int] -> StateT [Int] (Either String) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Int]
next
                                          Value
value <- Either String Value -> StateT [Int] (Either String) Value
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Array -> Int -> Either String Value
forall (m :: * -> *) a. Monad m => Vector a -> Int -> m a
Vector.indexM Array
arr Int
i)
                                          Either String d -> StateT [Int] (Either String) d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Value -> Either String d
GenericParser
rec Value
value))
                                      Constr
cons)
                         [Int
0..]
    [Constr]
_ -> Value -> Either String a
GenericParser
badData (Array -> Value
Array Array
arr)

-- | Parse a data constructor from an object.
parseObject :: Data a => GenericParser -> DataType -> HashMap Text Value -> Either String a
parseObject :: GenericParser -> DataType -> Object -> Either String a
parseObject GenericParser
rec DataType
typ Object
obj =
  case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (String -> Text
Text.pack String
"instance") Object
obj of
    Just (Value -> Either String String
parseString -> Right String
name) ->
      case (Constr -> Bool) -> [Constr] -> [Constr]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Constr
con -> Constr -> String
showConstr Constr
con String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name) (DataType -> [Constr]
dataTypeConstrs DataType
typ) of
        [Constr
con] ->
          let fields :: [String]
fields = Constr -> [String]
constrFields Constr
con
           in if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
fields
                then GenericParser -> Object -> Constr -> Either String a
forall a.
Data a =>
GenericParser -> Object -> Constr -> Either String a
makeSimple GenericParser
rec Object
obj Constr
con
                else GenericParser -> Object -> Constr -> [String] -> Either String a
forall a.
Data a =>
GenericParser -> Object -> Constr -> [String] -> Either String a
makeRecord GenericParser
rec Object
obj Constr
con [String]
fields
        [Constr]
_ -> Value -> Either String a
GenericParser
badData (Object -> Value
Object Object
obj)
    Maybe Value
_ -> Value -> Either String a
GenericParser
badData (Object -> Value
Object Object
obj)

-- | Make a simple ADT constructor from an object: { "slot1": 1, "slot2": 2} -> Foo 1 2
makeSimple :: Data a => GenericParser -> HashMap Text Value -> Constr -> Either String a
makeSimple :: GenericParser -> Object -> Constr -> Either String a
makeSimple GenericParser
rec Object
obj Constr
cons =
  StateT [Integer] (Either String) a -> [Integer] -> Either String a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ((forall d. Data d => StateT [Integer] (Either String) d)
-> Constr -> StateT [Integer] (Either String) a
forall (m :: * -> *) a.
(Monad m, Data a) =>
(forall d. Data d => m d) -> Constr -> m a
fromConstrM (do ~(Integer
i:[Integer]
next) <- StateT [Integer] (Either String) [Integer]
forall s (m :: * -> *). MonadState s m => m s
get
                              [Integer] -> StateT [Integer] (Either String) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Integer]
next
                              Value
value <- Either String Value -> StateT [Integer] (Either String) Value
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Object -> Text -> Either String Value
lookupField Object
obj (String -> Text
Text.pack (String
"slot" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i)))
                              Either String d -> StateT [Integer] (Either String) d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Value -> Either String d
GenericParser
rec Value
value))
                          Constr
cons)
             [(Integer
1::Integer)..]

-- | Make a record from a key-value: { "x": 1 } -> Foo { x = 1 }
makeRecord :: Data a => GenericParser -> HashMap Text Value -> Constr -> [String] -> Either String a
makeRecord :: GenericParser -> Object -> Constr -> [String] -> Either String a
makeRecord GenericParser
rec Object
obj Constr
cons =
  StateT [String] (Either String) a -> [String] -> Either String a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT [String] (Either String) a -> [String] -> Either String a)
-> StateT [String] (Either String) a -> [String] -> Either String a
forall a b. (a -> b) -> a -> b
$
    (forall d. Data d => StateT [String] (Either String) d)
-> Constr -> StateT [String] (Either String) a
forall (m :: * -> *) a.
(Monad m, Data a) =>
(forall d. Data d => m d) -> Constr -> m a
fromConstrM
      (do ~(String
key:[String]
next) <- StateT [String] (Either String) [String]
forall s (m :: * -> *). MonadState s m => m s
get
          [String] -> StateT [String] (Either String) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [String]
next
          Value
value <- Either String Value -> StateT [String] (Either String) Value
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Object -> Text -> Either String Value
lookupField Object
obj (String -> Text
Text.pack String
key))
          Either String d -> StateT [String] (Either String) d
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either String d -> StateT [String] (Either String) d)
-> Either String d -> StateT [String] (Either String) d
forall a b. (a -> b) -> a -> b
$ Value -> Either String d
GenericParser
rec Value
value)
      Constr
cons

lookupField :: HashMap Text Value -> Text -> Either String Value
lookupField :: Object -> Text -> Either String Value
lookupField Object
obj Text
key =
  String -> Maybe Value -> Either String Value
forall b a. b -> Maybe a -> Either b a
justRight (String
"Missing field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show (Object -> Value
Object Object
obj)) (Maybe Value -> Either String Value)
-> Maybe Value -> Either String Value
forall a b. (a -> b) -> a -> b
$
  Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup Text
key Object
obj

-- | Parse a float.
parseFloat :: Value -> Either String Float
parseFloat :: Value -> Either String Float
parseFloat = (Value -> Parser Float) -> Value -> Either String Float
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser Float
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Parse a double.
parseDouble :: Value -> Either String Double
parseDouble :: Value -> Either String Double
parseDouble = (Value -> Parser Double) -> Value -> Either String Double
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser Double
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Parse an int.
parseInt :: Value -> Either String Int
parseInt :: Value -> Either String Int
parseInt = (Value -> Parser Int) -> Value -> Either String Int
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Parse a bool.
parseBool :: Value -> Either String Bool
parseBool :: Value -> Either String Bool
parseBool Value
value = case Value
value of
  Bool Bool
n -> Bool -> Either String Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
n
  Value
_ -> Value -> Either String Bool
GenericParser
badData Value
value

-- | Parse a string.
parseString :: Value -> Either String String
parseString :: Value -> Either String String
parseString Value
value = case Value
value of
  String Text
s -> String -> Either String String
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> String
Text.unpack Text
s)
  Value
_ -> Value -> Either String String
GenericParser
badData Value
value

parseUTCTime :: Value -> Either String UTCTime
parseUTCTime :: Value -> Either String UTCTime
parseUTCTime Value
value = case Value -> Result UTCTime
forall a. FromJSON a => Value -> Result a
fromJSON Value
value of
  Success UTCTime
t -> UTCTime -> Either String UTCTime
forall a b. b -> Either a b
Right UTCTime
t
  Error String
_   -> Value -> Either String UTCTime
GenericParser
badData Value
value

-- | Parse a char.
parseChar :: Value -> Either String Char
parseChar :: Value -> Either String Char
parseChar Value
value = case Value
value of
  String Text
s | Just (Char
c,Text
_) <- Text -> Maybe (Char, Text)
Text.uncons Text
s -> Char -> Either String Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
  Value
_ -> Value -> Either String Char
GenericParser
badData Value
value

-- | Parse a Text.
parseText :: Value -> Either String Text
parseText :: Value -> Either String Text
parseText Value
value = case Value
value of
  String Text
s -> Text -> Either String Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
  Value
_ -> Value -> Either String Text
GenericParser
badData Value
value

-- | Parse an array.
parseArray :: Data a => GenericParser -> Value -> Either String [a]
parseArray :: GenericParser -> Value -> Either String [a]
parseArray GenericParser
rec Value
value = case Value
value of
  Array Array
xs -> (Value -> Either String a) -> [Value] -> Either String [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Either String a
GenericParser
rec (Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
xs)
  Value
_ -> Value -> Either String [a]
GenericParser
badData Value
value

-- | Parse unit.
parseUnit :: Value -> Either String ()
parseUnit :: Value -> Either String ()
parseUnit Value
value = case Value
value of
  Value
Null -> () -> Either String ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Value
_ -> Value -> Either String ()
GenericParser
badData Value
value

badData :: forall a. Data a => Value -> Either String a
badData :: Value -> Either String a
badData Value
value = String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$
  String
"Bad data in decodeFay - expected valid " String -> String -> String
forall a. [a] -> [a] -> [a]
++
  TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (a
forall a. HasCallStack => a
undefined :: a)) String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
", but got:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
  Value -> String
forall a. Show a => a -> String
show Value
value

justRight :: b -> Maybe a -> Either b a
justRight :: b -> Maybe a -> Either b a
justRight b
x Maybe a
Nothing = b -> Either b a
forall a b. a -> Either a b
Left b
x
justRight b
_ (Just a
y) = a -> Either b a
forall a b. b -> Either a b
Right a
y