{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module Text.Glabrous.Types where

import           Data.Aeson
import qualified Data.HashMap.Strict as H
import qualified Data.Text           as T
import           Data.Serialize
import           Data.Serialize.Text ()
import           Control.Arrow       (second)
import           GHC.Generics

data Token
  = Tag !T.Text
  | Literal !T.Text
  deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, (forall x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generic)

instance Serialize Token

newtype Template =
  Template
    { Template -> [Token]
content :: [Token] }
    deriving (Template -> Template -> Bool
(Template -> Template -> Bool)
-> (Template -> Template -> Bool) -> Eq Template
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Template -> Template -> Bool
$c/= :: Template -> Template -> Bool
== :: Template -> Template -> Bool
$c== :: Template -> Template -> Bool
Eq, Int -> Template -> ShowS
[Template] -> ShowS
Template -> String
(Int -> Template -> ShowS)
-> (Template -> String) -> ([Template] -> ShowS) -> Show Template
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Template] -> ShowS
$cshowList :: [Template] -> ShowS
show :: Template -> String
$cshow :: Template -> String
showsPrec :: Int -> Template -> ShowS
$cshowsPrec :: Int -> Template -> ShowS
Show, (forall x. Template -> Rep Template x)
-> (forall x. Rep Template x -> Template) -> Generic Template
forall x. Rep Template x -> Template
forall x. Template -> Rep Template x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Template x -> Template
$cfrom :: forall x. Template -> Rep Template x
Generic)

instance Serialize Template

newtype Context =
  Context
    { Context -> HashMap Text Text
variables :: H.HashMap T.Text T.Text }
    deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show)

instance ToJSON Context where
  toJSON :: Context -> Value
toJSON (Context HashMap Text Text
h) =
    [Pair] -> Value
object ((Text -> Value) -> (Text, Text) -> Pair
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Value
String ((Text, Text) -> Pair) -> [(Text, Text)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text Text -> [(Text, Text)]
forall k v. HashMap k v -> [(k, v)]
H.toList HashMap Text Text
h)

instance FromJSON Context where
  parseJSON :: Value -> Parser Context
parseJSON (Object Object
o) = Context -> Parser Context
forall (m :: * -> *) a. Monad m => a -> m a
return
    Context :: HashMap Text Text -> Context
Context { variables :: HashMap Text Text
variables = [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ((\(Text
k,String Text
v) -> (Text
k,Text
v)) (Pair -> (Text, Text)) -> [Pair] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> [Pair]
forall k v. HashMap k v -> [(k, v)]
H.toList Object
o) }
  parseJSON Value
_          = String -> Parser Context
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected an object"

data Result
  = Final !T.Text
  | Partial { Result -> Template
template :: !Template, Result -> Context
context :: !Context }
  deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)