{-|
Module      : Z.Data.JSON.Converter
Description : IR Converter
Copyright   : (c) Dong Han, 2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides tools for converting protocol IR (e.g. 'Value') to Haskell ADTs:

-}

module Z.Data.JSON.Converter where

import           Control.Applicative
import           Control.Monad
import qualified Control.Monad.Fail             as Fail
import           Control.DeepSeq
import           GHC.Generics
import qualified Z.Data.JSON.Builder            as JB
import qualified Z.Data.Text                    as T
import qualified Z.Data.Text.Print              as T

-- | Run a 'Converter' with input value.
convert :: (a -> Converter r) -> a -> Either ConvertError r
{-# INLINE convert #-}
convert :: (a -> Converter r) -> a -> Either ConvertError r
convert a -> Converter r
m a
v = Converter r
-> ([PathElement] -> Text -> Either ConvertError r)
-> (r -> Either ConvertError r)
-> Either ConvertError r
forall a.
Converter a
-> forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
runConverter (a -> Converter r
m a
v) (\ [PathElement]
paths Text
msg -> (ConvertError -> Either ConvertError r
forall a b. a -> Either a b
Left ([PathElement] -> Text -> ConvertError
ConvertError [PathElement]
paths Text
msg))) r -> Either ConvertError r
forall a b. b -> Either a b
Right

-- | Elements of a (JSON) Value path used to describe the location of an error.
data PathElement
    = Key {-# UNPACK #-} !T.Text
        -- ^ Path element of a key into an object,
        -- \"object.key\".
    | Index {-# UNPACK #-} !Int
        -- ^ Path element of an index into an
        -- array, \"array[index]\".
    | Embedded
        -- ^ path of a embedded (JSON) String
  deriving (PathElement -> PathElement -> Bool
(PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> Bool) -> Eq PathElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathElement -> PathElement -> Bool
$c/= :: PathElement -> PathElement -> Bool
== :: PathElement -> PathElement -> Bool
$c== :: PathElement -> PathElement -> Bool
Eq, Int -> PathElement -> ShowS
[PathElement] -> ShowS
PathElement -> String
(Int -> PathElement -> ShowS)
-> (PathElement -> String)
-> ([PathElement] -> ShowS)
-> Show PathElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathElement] -> ShowS
$cshowList :: [PathElement] -> ShowS
show :: PathElement -> String
$cshow :: PathElement -> String
showsPrec :: Int -> PathElement -> ShowS
$cshowsPrec :: Int -> PathElement -> ShowS
Show, Eq PathElement
Eq PathElement
-> (PathElement -> PathElement -> Ordering)
-> (PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> Bool)
-> (PathElement -> PathElement -> PathElement)
-> (PathElement -> PathElement -> PathElement)
-> Ord PathElement
PathElement -> PathElement -> Bool
PathElement -> PathElement -> Ordering
PathElement -> PathElement -> PathElement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PathElement -> PathElement -> PathElement
$cmin :: PathElement -> PathElement -> PathElement
max :: PathElement -> PathElement -> PathElement
$cmax :: PathElement -> PathElement -> PathElement
>= :: PathElement -> PathElement -> Bool
$c>= :: PathElement -> PathElement -> Bool
> :: PathElement -> PathElement -> Bool
$c> :: PathElement -> PathElement -> Bool
<= :: PathElement -> PathElement -> Bool
$c<= :: PathElement -> PathElement -> Bool
< :: PathElement -> PathElement -> Bool
$c< :: PathElement -> PathElement -> Bool
compare :: PathElement -> PathElement -> Ordering
$ccompare :: PathElement -> PathElement -> Ordering
$cp1Ord :: Eq PathElement
Ord, (forall x. PathElement -> Rep PathElement x)
-> (forall x. Rep PathElement x -> PathElement)
-> Generic PathElement
forall x. Rep PathElement x -> PathElement
forall x. PathElement -> Rep PathElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathElement x -> PathElement
$cfrom :: forall x. PathElement -> Rep PathElement x
Generic, PathElement -> ()
(PathElement -> ()) -> NFData PathElement
forall a. (a -> ()) -> NFData a
rnf :: PathElement -> ()
$crnf :: PathElement -> ()
NFData)

-- | Error info with (JSON) Path info.
data ConvertError = ConvertError { ConvertError -> [PathElement]
errPath :: [PathElement], ConvertError -> Text
errMsg :: T.Text }
        deriving (ConvertError -> ConvertError -> Bool
(ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> Bool) -> Eq ConvertError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConvertError -> ConvertError -> Bool
$c/= :: ConvertError -> ConvertError -> Bool
== :: ConvertError -> ConvertError -> Bool
$c== :: ConvertError -> ConvertError -> Bool
Eq, Eq ConvertError
Eq ConvertError
-> (ConvertError -> ConvertError -> Ordering)
-> (ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> Bool)
-> (ConvertError -> ConvertError -> ConvertError)
-> (ConvertError -> ConvertError -> ConvertError)
-> Ord ConvertError
ConvertError -> ConvertError -> Bool
ConvertError -> ConvertError -> Ordering
ConvertError -> ConvertError -> ConvertError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConvertError -> ConvertError -> ConvertError
$cmin :: ConvertError -> ConvertError -> ConvertError
max :: ConvertError -> ConvertError -> ConvertError
$cmax :: ConvertError -> ConvertError -> ConvertError
>= :: ConvertError -> ConvertError -> Bool
$c>= :: ConvertError -> ConvertError -> Bool
> :: ConvertError -> ConvertError -> Bool
$c> :: ConvertError -> ConvertError -> Bool
<= :: ConvertError -> ConvertError -> Bool
$c<= :: ConvertError -> ConvertError -> Bool
< :: ConvertError -> ConvertError -> Bool
$c< :: ConvertError -> ConvertError -> Bool
compare :: ConvertError -> ConvertError -> Ordering
$ccompare :: ConvertError -> ConvertError -> Ordering
$cp1Ord :: Eq ConvertError
Ord, (forall x. ConvertError -> Rep ConvertError x)
-> (forall x. Rep ConvertError x -> ConvertError)
-> Generic ConvertError
forall x. Rep ConvertError x -> ConvertError
forall x. ConvertError -> Rep ConvertError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConvertError x -> ConvertError
$cfrom :: forall x. ConvertError -> Rep ConvertError x
Generic, ConvertError -> ()
(ConvertError -> ()) -> NFData ConvertError
forall a. (a -> ()) -> NFData a
rnf :: ConvertError -> ()
$crnf :: ConvertError -> ()
NFData)

instance Show ConvertError where
    show :: ConvertError -> String
show = ConvertError -> String
forall a. Print a => a -> String
T.toString

instance T.Print ConvertError where
    toUTF8BuilderP :: Int -> ConvertError -> Builder ()
toUTF8BuilderP Int
_ (ConvertError [] Text
msg) = Text -> Builder ()
forall a. Print a => a -> Builder ()
T.toUTF8Builder Text
msg
    toUTF8BuilderP Int
_ (ConvertError [PathElement]
paths Text
msg) = do
        (PathElement -> Builder ()) -> [PathElement] -> Builder ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PathElement -> Builder ()
renderPath ([PathElement] -> [PathElement]
forall a. [a] -> [a]
reverse [PathElement]
paths)
        Char -> Builder ()
T.char7 Char
':'
        Text -> Builder ()
forall a. Print a => a -> Builder ()
T.toUTF8Builder Text
msg
      where
        renderPath :: PathElement -> Builder ()
renderPath (Index Int
ix) = Char -> Builder ()
T.char7 Char
'[' Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
T.int Int
ix Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Builder ()
T.char7 Char
']'
        renderPath (Key Text
k)    = Char -> Builder ()
T.char7 Char
'.' Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Text -> Builder ()
JB.string Text
k)
        renderPath PathElement
Embedded   = Builder ()
"<Embedded>"

-- | 'Converter' provides a monadic interface to convert protocol IR  (e.g.'Value') to Haskell ADT.
--
newtype Converter a = Converter { Converter a
-> forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
runConverter :: forall r. ([PathElement] -> T.Text -> r) -> (a -> r) -> r }

instance Functor Converter where
    fmap :: (a -> b) -> Converter a -> Converter b
fmap a -> b
f Converter a
m = (forall r. ([PathElement] -> Text -> r) -> (b -> r) -> r)
-> Converter b
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf b -> r
k -> Converter a -> ([PathElement] -> Text -> r) -> (a -> r) -> r
forall a.
Converter a
-> forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
runConverter Converter a
m [PathElement] -> Text -> r
kf (b -> r
k (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f))
    {-# INLINE fmap #-}

instance Applicative Converter where
    pure :: a -> Converter a
pure a
a = (forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
_ a -> r
k -> a -> r
k a
a)
    {-# INLINE pure #-}
    (Converter forall r. ([PathElement] -> Text -> r) -> ((a -> b) -> r) -> r
f) <*> :: Converter (a -> b) -> Converter a -> Converter b
<*> (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
g) = (forall r. ([PathElement] -> Text -> r) -> (b -> r) -> r)
-> Converter b
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf b -> r
k ->
        ([PathElement] -> Text -> r) -> ((a -> b) -> r) -> r
forall r. ([PathElement] -> Text -> r) -> ((a -> b) -> r) -> r
f [PathElement] -> Text -> r
kf (\ a -> b
f' ->  ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
g [PathElement] -> Text -> r
kf (b -> r
k (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f')))
    {-# INLINE (<*>) #-}

instance Alternative Converter where
    {-# INLINE (<|>) #-}
    (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
f) <|> :: Converter a -> Converter a -> Converter a
<|> (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
g) = (forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf a -> r
k -> ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
f (\ [PathElement]
_ Text
_ -> ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
g [PathElement] -> Text -> r
kf a -> r
k) a -> r
k)
    {-# INLINE empty #-}
    empty :: Converter a
empty = Text -> Converter a
forall a. Text -> Converter a
fail' Text
"Z.Data.JSON.Converter(Alternative).empty"

instance MonadPlus Converter where
    mzero :: Converter a
mzero = Converter a
forall (f :: * -> *) a. Alternative f => f a
empty
    {-# INLINE mzero #-}
    mplus :: Converter a -> Converter a -> Converter a
mplus = Converter a -> Converter a -> Converter a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
    {-# INLINE mplus #-}

instance Monad Converter where
    (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
f) >>= :: Converter a -> (a -> Converter b) -> Converter b
>>= a -> Converter b
g = (forall r. ([PathElement] -> Text -> r) -> (b -> r) -> r)
-> Converter b
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf b -> r
k ->
        ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
f [PathElement] -> Text -> r
kf (\ a
a -> Converter b -> ([PathElement] -> Text -> r) -> (b -> r) -> r
forall a.
Converter a
-> forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
runConverter (a -> Converter b
g a
a) [PathElement] -> Text -> r
kf b -> r
k))
    {-# INLINE (>>=) #-}
    return :: a -> Converter a
return = a -> Converter a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}

instance Fail.MonadFail Converter where
    {-# INLINE fail #-}
    fail :: String -> Converter a
fail = Text -> Converter a
forall a. Text -> Converter a
fail' (Text -> Converter a) -> (String -> Text) -> String -> Converter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | 'T.Text' version of 'fail'.
fail' :: T.Text -> Converter a
{-# INLINE fail' #-}
fail' :: Text -> Converter a
fail' Text
msg = (forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf a -> r
_ -> [PathElement] -> Text -> r
kf [] Text
msg)

-- | Add (JSON) Path context to a converter
--
-- When converting a complex structure, it helps to annotate (sub)converters
-- with context, so that if an error occurs, you can find its location.
--
-- > withFlatMapR "Person" $ \o ->
-- >   Person
-- >     <$> o .: "name" <?> Key "name"
-- >     <*> o .: "age" <?> Key "age"
--
-- (Standard methods like '(.:)' already do this.)
--
-- With such annotations, if an error occurs, you will get a (JSON) Path location of that error.
(<?>) :: Converter a -> PathElement -> Converter a
{-# INLINE (<?>) #-}
(Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
p) <?> :: Converter a -> PathElement -> Converter a
<?> PathElement
path = (forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf a -> r
k -> ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
p ([PathElement] -> Text -> r
kf ([PathElement] -> Text -> r)
-> ([PathElement] -> [PathElement]) -> [PathElement] -> Text -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathElement
pathPathElement -> [PathElement] -> [PathElement]
forall a. a -> [a] -> [a]
:)) a -> r
k)
infixl 9 <?>

-- | Add context to a failure message, indicating the name of the structure
-- being converted.
--
-- > prependContext "MyType" (fail "[error message]")
-- > -- Error: "converting MyType failed, [error message]"
prependContext :: T.Text -> Converter a -> Converter a
{-# INLINE prependContext #-}
prependContext :: Text -> Converter a -> Converter a
prependContext Text
name (Converter forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
p) = (forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
forall a.
(forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r)
-> Converter a
Converter (\ [PathElement] -> Text -> r
kf a -> r
k ->
    ([PathElement] -> Text -> r) -> (a -> r) -> r
forall r. ([PathElement] -> Text -> r) -> (a -> r) -> r
p (\ [PathElement]
paths Text
msg -> [PathElement] -> Text -> r
kf [PathElement]
paths ([Text] -> Text
T.concat [Text
"converting ", Text
name, Text
" failed, ", Text
msg])) a -> r
k)