{-# LANGUAGE
      LambdaCase
    , FlexibleInstances 
    , FlexibleContexts
    , DeriveGeneric  
    , OverloadedStrings 
    #-}
module Control.Internal.Conduit (
    inConduit, 
    ParseResult(..), 
    Res(..), 
    Req(..) 
    ) where 

import GHC.Generics
import Data.Text (Text)
import Control.Applicative  ((<|>))
import Control.Monad.State.Lazy
import Data.Aeson.Types hiding ( parse )
import Data.Aeson 
import qualified Data.ByteString as S
import Data.Conduit 
import Data.Attoparsec.ByteString 

-- | Decode from bytestring into a JSON object. Simplified from hackage package: json-rpc 
inConduit :: (Monad n) => (FromJSON a) => ConduitT S.ByteString (ParseResult a) n ()
inConduit :: forall (n :: * -> *) a.
(Monad n, FromJSON a) =>
ConduitT ByteString (ParseResult a) n ()
inConduit = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT
  (Maybe (ByteString -> Result Value))
  (ConduitT ByteString (ParseResult a) n)
  ()
l forall a. Maybe a
Nothing
    where 
    l :: StateT
  (Maybe (ByteString -> Result Value))
  (ConduitT ByteString (ParseResult a) n)
  ()
l = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty) (forall {m :: * -> *}.
MonadState (Maybe (ByteString -> Result Value)) m =>
ByteString -> m (Result Value)
r forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Result Value
-> StateT
     (Maybe (ByteString -> Result Value))
     (ConduitT ByteString (ParseResult a) n)
     ()
h)
    r :: ByteString -> m (Result Value)
r ByteString
i = forall s (m :: * -> *). MonadState s m => m s
get  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (ByteString -> Result Value)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> ByteString -> Result a
parse Parser Value
json' ByteString
i
        Just ByteString -> Result Value
k  ->  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Result Value
k ByteString
i 
    h :: Result Value
-> StateT
     (Maybe (ByteString -> Result Value))
     (ConduitT ByteString (ParseResult a) n)
     ()
h = \case
        Fail{} -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall x. ParseResult x
ParseErr) 
        Partial ByteString -> Result Value
i -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall a. a -> Maybe a
Just ByteString -> Result Value
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  (Maybe (ByteString -> Result Value))
  (ConduitT ByteString (ParseResult a) n)
  ()
l
        Done ByteString
_ Value
v -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield forall a b. (a -> b) -> a -> b
$ forall {x}. Maybe x -> ParseResult x
fin forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a. FromJSON a => Value -> Parser a
parseJSON Value
v 
    fin :: Maybe x -> ParseResult x
fin = \case
        Maybe x
Nothing -> forall x. ParseResult x
InvalidReq
        Just x
c -> forall x. x -> ParseResult x
Correct x
c

data ParseResult x = 
    Correct !x |
    InvalidReq | 
    ParseErr 
    deriving (Int -> ParseResult x -> ShowS
forall x. Show x => Int -> ParseResult x -> ShowS
forall x. Show x => [ParseResult x] -> ShowS
forall x. Show x => ParseResult x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseResult x] -> ShowS
$cshowList :: forall x. Show x => [ParseResult x] -> ShowS
show :: ParseResult x -> String
$cshow :: forall x. Show x => ParseResult x -> String
showsPrec :: Int -> ParseResult x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> ParseResult x -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (ParseResult x) x -> ParseResult x
forall x x. ParseResult x -> Rep (ParseResult x) x
$cto :: forall x x. Rep (ParseResult x) x -> ParseResult x
$cfrom :: forall x x. ParseResult x -> Rep (ParseResult x) x
Generic) 
instance ToJSON a => ToJSON (ParseResult a) where 
    toJSON :: ParseResult a -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions 
instance FromJSON a => FromJSON (ParseResult a) 
data Req x = Req { 
   forall x. Req x -> Text
getMethod :: Text,
   forall x. Req x -> x
getParams :: x,
   forall x. Req x -> Maybe Value
getReqId :: Maybe Value }
   deriving (Int -> Req x -> ShowS
forall x. Show x => Int -> Req x -> ShowS
forall x. Show x => [Req x] -> ShowS
forall x. Show x => Req x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Req x] -> ShowS
$cshowList :: forall x. Show x => [Req x] -> ShowS
show :: Req x -> String
$cshow :: forall x. Show x => Req x -> String
showsPrec :: Int -> Req x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> Req x -> ShowS
Show) 
   
data Res a =
    Res { forall a. Res a -> a
getResBody :: a,
          forall a. Res a -> Value
getResId :: Value }
    | ErrRes  {
          forall a. Res a -> Text
errMsg :: Text,
          forall a. Res a -> Maybe Value
errId :: Maybe Value }
    deriving (Int -> Res a -> ShowS
forall a. Show a => Int -> Res a -> ShowS
forall a. Show a => [Res a] -> ShowS
forall a. Show a => Res a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Res a] -> ShowS
$cshowList :: forall a. Show a => [Res a] -> ShowS
show :: Res a -> String
$cshow :: forall a. Show a => Res a -> String
showsPrec :: Int -> Res a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Res a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Res a) x -> Res a
forall a x. Res a -> Rep (Res a) x
$cto :: forall a x. Rep (Res a) x -> Res a
$cfrom :: forall a x. Res a -> Rep (Res a) x
Generic)

instance FromJSON (Req Value) where
    parseJSON :: Value -> Parser (Req Value)
parseJSON (Object Object
v) = do
        Text
version <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
version forall a. Eq a => a -> a -> Bool
== (Text
"2.0" :: Text))
        forall x. Text -> x -> Maybe Value -> Req x
Req forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"method"
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params") forall a. Parser (Maybe a) -> a -> Parser a
.!= Value
emptyArray
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:?  Key
"id"
    parseJSON Value
_ = forall a. Monoid a => a
mempty

instance FromJSON a => FromJSON (Res a) where
    parseJSON :: Value -> Parser (Res a)
parseJSON (Object Object
v) = do
        Text
version <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
version forall a. Eq a => a -> a -> Bool
== (Text
"2.0" :: Text))
        Parser (Res a)
fromResult forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a}. Parser (Res a)
fromError
        where
            fromResult :: Parser (Res a)
fromResult = forall a. a -> Value -> Res a
Res forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromJSON a => Value -> Parser a
parseJSON)
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
            fromError :: Parser (Res a)
fromError = do
                Object
err <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
                forall a. Text -> Maybe Value -> Res a
ErrRes  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
err forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v   forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    parseJSON (Array Array
a) = forall a. Monoid a => a
mempty
    parseJSON Value
_ = forall a. Monoid a => a
mempty

instance ToJSON a => ToJSON (Req a) where
    toJSON :: Req a -> Value
toJSON (Req Text
m a
ps Maybe Value
i) =
        [Pair] -> Value
object [ Key
"jsonrpc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text)
               , Key
"method"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
m
               , Key
"params"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON a
ps
               , Key
"id"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
i ]

instance ToJSON (Res Value) where
    toJSON :: Res Value -> Value
toJSON (Res Value
x Value
i) = [Pair] -> Value
object [ 
        Key
"jsonrpc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text),
        Key
"result"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
x,
        Key
"id"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
i ]
    toJSON (ErrRes Text
msg Maybe Value
i) = [Pair] -> Value
object [ 
        Key
"jsonrpc" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text),
        Key
"error"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg],
        Key
"id"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
i ]