{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Text.EDE.Internal.Types where
import Control.Applicative (Alternative (empty, (<|>)))
import qualified Control.Comonad as Comonad
import Control.Comonad.Cofree (Cofree)
import qualified Control.Lens as Lens
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Pair, Value (..))
import qualified Data.Functor.Classes as Functor.Classes
import Data.HashMap.Strict (HashMap)
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import qualified Data.Text as Text
import Prettyprinter (Doc, Pretty (..))
import qualified Prettyprinter as PP
import qualified Prettyprinter.Render.Terminal as PP
import Text.EDE.Internal.Compat
import Text.Trifecta.Delta (Delta, HasDelta)
import qualified Text.Trifecta.Delta as Trifecta.Delta
type AnsiDoc = Doc PP.AnsiStyle
class AnsiPretty a where
apretty :: a -> AnsiDoc
newtype PP a = PP {PP a -> a
unPP :: a}
pp :: AnsiPretty (PP a) => a -> AnsiDoc
pp :: a -> AnsiDoc
pp = PP a -> AnsiDoc
forall a. AnsiPretty a => a -> AnsiDoc
apretty (PP a -> AnsiDoc) -> (a -> PP a) -> a -> AnsiDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PP a
forall a. a -> PP a
PP
(</>) :: Doc ann -> Doc ann -> Doc ann
Doc ann
x </> :: Doc ann -> Doc ann -> Doc ann
</> Doc ann
y = Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
PP.softline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y
bold :: AnsiDoc -> AnsiDoc
bold :: AnsiDoc -> AnsiDoc
bold = AnsiStyle -> AnsiDoc -> AnsiDoc
forall ann. ann -> Doc ann -> Doc ann
PP.annotate AnsiStyle
PP.bold
red :: AnsiDoc -> AnsiDoc
red :: AnsiDoc -> AnsiDoc
red = AnsiStyle -> AnsiDoc -> AnsiDoc
forall ann. ann -> Doc ann -> Doc ann
PP.annotate (Color -> AnsiStyle
PP.color Color
PP.Red)
instance AnsiPretty (PP Text) where
apretty :: PP Text -> AnsiDoc
apretty = String -> AnsiDoc
forall a ann. Pretty a => a -> Doc ann
pretty (String -> AnsiDoc) -> (PP Text -> String) -> PP Text -> AnsiDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (PP Text -> Text) -> PP Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP Text -> Text
forall a. PP a -> a
unPP
instance AnsiPretty (PP Value) where
apretty :: PP Value -> AnsiDoc
apretty (PP Value
v) =
case Value
v of
Value
Null -> AnsiDoc
"Null"
Bool Bool
_ -> AnsiDoc
"Bool"
Number Scientific
_ -> AnsiDoc
"Scientific"
Object Object
_ -> AnsiDoc
"Object"
Array Array
_ -> AnsiDoc
"Array"
String Text
_ -> AnsiDoc
"String"
data Result a
= Success a
| Failure AnsiDoc
deriving (Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show, a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor, Result a -> Bool
(a -> m) -> Result a -> m
(a -> b -> b) -> b -> Result a -> b
(forall m. Monoid m => Result m -> m)
-> (forall m a. Monoid m => (a -> m) -> Result a -> m)
-> (forall m a. Monoid m => (a -> m) -> Result a -> m)
-> (forall a b. (a -> b -> b) -> b -> Result a -> b)
-> (forall a b. (a -> b -> b) -> b -> Result a -> b)
-> (forall b a. (b -> a -> b) -> b -> Result a -> b)
-> (forall b a. (b -> a -> b) -> b -> Result a -> b)
-> (forall a. (a -> a -> a) -> Result a -> a)
-> (forall a. (a -> a -> a) -> Result a -> a)
-> (forall a. Result a -> [a])
-> (forall a. Result a -> Bool)
-> (forall a. Result a -> Int)
-> (forall a. Eq a => a -> Result a -> Bool)
-> (forall a. Ord a => Result a -> a)
-> (forall a. Ord a => Result a -> a)
-> (forall a. Num a => Result a -> a)
-> (forall a. Num a => Result a -> a)
-> Foldable Result
forall a. Eq a => a -> Result a -> Bool
forall a. Num a => Result a -> a
forall a. Ord a => Result a -> a
forall m. Monoid m => Result m -> m
forall a. Result a -> Bool
forall a. Result a -> Int
forall a. Result a -> [a]
forall a. (a -> a -> a) -> Result a -> a
forall m a. Monoid m => (a -> m) -> Result a -> m
forall b a. (b -> a -> b) -> b -> Result a -> b
forall a b. (a -> b -> b) -> b -> Result a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Result a -> a
$cproduct :: forall a. Num a => Result a -> a
sum :: Result a -> a
$csum :: forall a. Num a => Result a -> a
minimum :: Result a -> a
$cminimum :: forall a. Ord a => Result a -> a
maximum :: Result a -> a
$cmaximum :: forall a. Ord a => Result a -> a
elem :: a -> Result a -> Bool
$celem :: forall a. Eq a => a -> Result a -> Bool
length :: Result a -> Int
$clength :: forall a. Result a -> Int
null :: Result a -> Bool
$cnull :: forall a. Result a -> Bool
toList :: Result a -> [a]
$ctoList :: forall a. Result a -> [a]
foldl1 :: (a -> a -> a) -> Result a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Result a -> a
foldr1 :: (a -> a -> a) -> Result a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Result a -> a
foldl' :: (b -> a -> b) -> b -> Result a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Result a -> b
foldl :: (b -> a -> b) -> b -> Result a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Result a -> b
foldr' :: (a -> b -> b) -> b -> Result a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Result a -> b
foldr :: (a -> b -> b) -> b -> Result a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Result a -> b
foldMap' :: (a -> m) -> Result a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Result a -> m
foldMap :: (a -> m) -> Result a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Result a -> m
fold :: Result m -> m
$cfold :: forall m. Monoid m => Result m -> m
Foldable, Functor Result
Foldable Result
Functor Result
-> Foldable Result
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Result a -> f (Result b))
-> (forall (f :: * -> *) a.
Applicative f =>
Result (f a) -> f (Result a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Result a -> m (Result b))
-> (forall (m :: * -> *) a.
Monad m =>
Result (m a) -> m (Result a))
-> Traversable Result
(a -> f b) -> Result a -> f (Result b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Result (m a) -> m (Result a)
forall (f :: * -> *) a.
Applicative f =>
Result (f a) -> f (Result a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Result a -> m (Result b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Result a -> f (Result b)
sequence :: Result (m a) -> m (Result a)
$csequence :: forall (m :: * -> *) a. Monad m => Result (m a) -> m (Result a)
mapM :: (a -> m b) -> Result a -> m (Result b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Result a -> m (Result b)
sequenceA :: Result (f a) -> f (Result a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Result (f a) -> f (Result a)
traverse :: (a -> f b) -> Result a -> f (Result b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Result a -> f (Result b)
$cp2Traversable :: Foldable Result
$cp1Traversable :: Functor Result
Traversable)
$(Lens.makePrisms ''Result)
instance Monad Result where
return :: a -> Result a
return = a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
Success a
x >>= :: Result a -> (a -> Result b) -> Result b
>>= a -> Result b
k = a -> Result b
k a
x
Failure AnsiDoc
e >>= a -> Result b
_ = AnsiDoc -> Result b
forall a. AnsiDoc -> Result a
Failure AnsiDoc
e
{-# INLINE (>>=) #-}
instance Applicative Result where
pure :: a -> Result a
pure = a -> Result a
forall a. a -> Result a
Success
{-# INLINE pure #-}
Success a -> b
f <*> :: Result (a -> b) -> Result a -> Result b
<*> Success a
x = b -> Result b
forall a. a -> Result a
Success (a -> b
f a
x)
Success a -> b
_ <*> Failure AnsiDoc
e = AnsiDoc -> Result b
forall a. AnsiDoc -> Result a
Failure AnsiDoc
e
Failure AnsiDoc
e <*> Success a
_ = AnsiDoc -> Result b
forall a. AnsiDoc -> Result a
Failure AnsiDoc
e
Failure AnsiDoc
e <*> Failure AnsiDoc
e' = AnsiDoc -> Result b
forall a. AnsiDoc -> Result a
Failure ([AnsiDoc] -> AnsiDoc
forall ann. [Doc ann] -> Doc ann
PP.vsep [AnsiDoc
e, AnsiDoc
e'])
{-# INLINE (<*>) #-}
instance Alternative Result where
Success a
x <|> :: Result a -> Result a -> Result a
<|> Success a
_ = a -> Result a
forall a. a -> Result a
Success a
x
Success a
x <|> Failure AnsiDoc
_ = a -> Result a
forall a. a -> Result a
Success a
x
Failure AnsiDoc
_ <|> Success a
x = a -> Result a
forall a. a -> Result a
Success a
x
Failure AnsiDoc
e <|> Failure AnsiDoc
e' = AnsiDoc -> Result a
forall a. AnsiDoc -> Result a
Failure ([AnsiDoc] -> AnsiDoc
forall ann. [Doc ann] -> Doc ann
PP.vsep [AnsiDoc
e, AnsiDoc
e'])
{-# INLINE (<|>) #-}
empty :: Result a
empty = AnsiDoc -> Result a
forall a. AnsiDoc -> Result a
Failure AnsiDoc
forall a. Monoid a => a
mempty
{-# INLINE empty #-}
instance Show a => AnsiPretty (Result a) where
apretty :: Result a -> AnsiDoc
apretty (Success a
x) = String -> AnsiDoc
forall a ann. Pretty a => a -> Doc ann
pretty (a -> String
forall a. Show a => a -> String
show a
x)
apretty (Failure AnsiDoc
e) = AnsiDoc
e
eitherResult :: Result a -> Either String a
eitherResult :: Result a -> Either String a
eitherResult = (AnsiDoc -> Either String a)
-> (a -> Either String a) -> Result a -> Either String a
forall b a. (AnsiDoc -> b) -> (a -> b) -> Result a -> b
result (String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a)
-> (AnsiDoc -> String) -> AnsiDoc -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnsiDoc -> String
forall a. Show a => a -> String
show) a -> Either String a
forall a b. b -> Either a b
Right
result ::
(AnsiDoc -> b) ->
(a -> b) ->
Result a ->
b
result :: (AnsiDoc -> b) -> (a -> b) -> Result a -> b
result AnsiDoc -> b
_ a -> b
g (Success a
x) = a -> b
g a
x
result AnsiDoc -> b
f a -> b
_ (Failure AnsiDoc
e) = AnsiDoc -> b
f AnsiDoc
e
success :: Monad m => a -> m (Result a)
success :: a -> m (Result a)
success = Result a -> m (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> m (Result a)) -> (a -> Result a) -> a -> m (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result a
forall a. a -> Result a
Success
failure :: Monad m => AnsiDoc -> m (Result a)
failure :: AnsiDoc -> m (Result a)
failure = Result a -> m (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> m (Result a))
-> (AnsiDoc -> Result a) -> AnsiDoc -> m (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnsiDoc -> Result a
forall a. AnsiDoc -> Result a
Failure
type Delim = (String, String)
data Syntax = Syntax
{ Syntax -> Delim
_delimPragma :: !Delim,
Syntax -> Delim
_delimInline :: !Delim,
:: !Delim,
Syntax -> Delim
_delimBlock :: !Delim
}
$()
type Resolver m = Syntax -> Id -> Delta -> m (Result Template)
data Template = Template
{ Template -> Text
_tmplName :: !Text,
Template -> Exp Delta
_tmplExp :: !(Exp Delta),
Template -> HashMap Text (Exp Delta)
_tmplIncl :: HashMap Id (Exp Delta)
}
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)
type Id = Text
newtype Var = Var (NonEmpty Id)
deriving (Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c== :: Var -> Var -> Bool
Eq)
instance AnsiPretty Var where
apretty :: Var -> AnsiDoc
apretty (Var NonEmpty Text
is) =
[AnsiDoc] -> AnsiDoc
forall ann. [Doc ann] -> Doc ann
PP.hcat
([AnsiDoc] -> AnsiDoc)
-> ([Text] -> [AnsiDoc]) -> [Text] -> AnsiDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnsiDoc -> [AnsiDoc] -> [AnsiDoc]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
PP.punctuate AnsiDoc
"."
([AnsiDoc] -> [AnsiDoc])
-> ([Text] -> [AnsiDoc]) -> [Text] -> [AnsiDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> AnsiDoc) -> [Text] -> [AnsiDoc]
forall a b. (a -> b) -> [a] -> [b]
map (AnsiStyle -> AnsiDoc -> AnsiDoc
forall ann. ann -> Doc ann -> Doc ann
PP.annotate AnsiStyle
PP.bold (AnsiDoc -> AnsiDoc) -> (Text -> AnsiDoc) -> Text -> AnsiDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AnsiDoc
forall a. AnsiPretty (PP a) => a -> AnsiDoc
pp)
([Text] -> [AnsiDoc]) -> ([Text] -> [Text]) -> [Text] -> [AnsiDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse
([Text] -> AnsiDoc) -> [Text] -> AnsiDoc
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Text
is
instance Show Var where
show :: Var -> String
show = AnsiDoc -> String
forall a. Show a => a -> String
show (AnsiDoc -> String) -> (Var -> AnsiDoc) -> Var -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> AnsiDoc
forall a. AnsiPretty a => a -> AnsiDoc
apretty
data Collection where
Col :: Foldable f => Int -> f (Maybe Text, Value) -> Collection
data Pat
= PWild
| PVar !Var
| PLit !Value
deriving (Pat -> Pat -> Bool
(Pat -> Pat -> Bool) -> (Pat -> Pat -> Bool) -> Eq Pat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pat -> Pat -> Bool
$c/= :: Pat -> Pat -> Bool
== :: Pat -> Pat -> Bool
$c== :: Pat -> Pat -> Bool
Eq, Int -> Pat -> ShowS
[Pat] -> ShowS
Pat -> String
(Int -> Pat -> ShowS)
-> (Pat -> String) -> ([Pat] -> ShowS) -> Show Pat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pat] -> ShowS
$cshowList :: [Pat] -> ShowS
show :: Pat -> String
$cshow :: Pat -> String
showsPrec :: Int -> Pat -> ShowS
$cshowsPrec :: Int -> Pat -> ShowS
Show)
type Alt a = (Pat, a)
data ExpF a
= ELit !Value
| EVar !Var
| EFun !Id
| EApp !a !a
| ELet !Id !a !a
| ECase !a [Alt a]
| ELoop !Id !a !a
| EIncl !Text
deriving (ExpF a -> ExpF a -> Bool
(ExpF a -> ExpF a -> Bool)
-> (ExpF a -> ExpF a -> Bool) -> Eq (ExpF a)
forall a. Eq a => ExpF a -> ExpF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpF a -> ExpF a -> Bool
$c/= :: forall a. Eq a => ExpF a -> ExpF a -> Bool
== :: ExpF a -> ExpF a -> Bool
$c== :: forall a. Eq a => ExpF a -> ExpF a -> Bool
Eq, Int -> ExpF a -> ShowS
[ExpF a] -> ShowS
ExpF a -> String
(Int -> ExpF a -> ShowS)
-> (ExpF a -> String) -> ([ExpF a] -> ShowS) -> Show (ExpF a)
forall a. Show a => Int -> ExpF a -> ShowS
forall a. Show a => [ExpF a] -> ShowS
forall a. Show a => ExpF a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpF a] -> ShowS
$cshowList :: forall a. Show a => [ExpF a] -> ShowS
show :: ExpF a -> String
$cshow :: forall a. Show a => ExpF a -> String
showsPrec :: Int -> ExpF a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ExpF a -> ShowS
Show, a -> ExpF b -> ExpF a
(a -> b) -> ExpF a -> ExpF b
(forall a b. (a -> b) -> ExpF a -> ExpF b)
-> (forall a b. a -> ExpF b -> ExpF a) -> Functor ExpF
forall a b. a -> ExpF b -> ExpF a
forall a b. (a -> b) -> ExpF a -> ExpF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ExpF b -> ExpF a
$c<$ :: forall a b. a -> ExpF b -> ExpF a
fmap :: (a -> b) -> ExpF a -> ExpF b
$cfmap :: forall a b. (a -> b) -> ExpF a -> ExpF b
Functor)
instance Functor.Classes.Eq1 ExpF where
liftEq :: (a -> b -> Bool) -> ExpF a -> ExpF b -> Bool
liftEq a -> b -> Bool
_ (ELit Value
a) (ELit Value
b) = Value
a Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
b
liftEq a -> b -> Bool
_ (EVar Var
a) (EVar Var
b) = Var
a Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
b
liftEq a -> b -> Bool
_ (EFun Text
a) (EFun Text
b) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b
liftEq a -> b -> Bool
c (EApp a
a1 a
a2) (EApp b
b1 b
b2) = a
a1 a -> b -> Bool
`c` b
b1 Bool -> Bool -> Bool
&& a
a2 a -> b -> Bool
`c` b
b2
liftEq a -> b -> Bool
c (ELet Text
a0 a
a1 a
a2) (ELet Text
b0 b
b1 b
b2) = Text
a0 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b0 Bool -> Bool -> Bool
&& a
a1 a -> b -> Bool
`c` b
b1 Bool -> Bool -> Bool
&& a
a2 a -> b -> Bool
`c` b
b2
liftEq a -> b -> Bool
c (ECase a
a [Alt a]
as) (ECase b
b [Alt b]
bs) = a
a a -> b -> Bool
`c` b
b Bool -> Bool -> Bool
&& (((Alt a, Alt b) -> Bool) -> [(Alt a, Alt b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
List.all ((Alt a -> Alt b -> Bool) -> (Alt a, Alt b) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Alt a -> Alt b -> Bool
altEq) ([(Alt a, Alt b)] -> Bool) -> [(Alt a, Alt b)] -> Bool
forall a b. (a -> b) -> a -> b
$ [Alt a] -> [Alt b] -> [(Alt a, Alt b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alt a]
as [Alt b]
bs)
where
altEq :: Alt a -> Alt b -> Bool
altEq (Pat
pA, a
a') (Pat
pB, b
b') = Pat
pA Pat -> Pat -> Bool
forall a. Eq a => a -> a -> Bool
== Pat
pB Bool -> Bool -> Bool
&& a
a' a -> b -> Bool
`c` b
b'
liftEq a -> b -> Bool
c (ELoop Text
a0 a
a1 a
a2) (ELoop Text
b0 b
b1 b
b2) = Text
a0 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b0 Bool -> Bool -> Bool
&& a
a1 a -> b -> Bool
`c` b
b1 Bool -> Bool -> Bool
&& a
a2 a -> b -> Bool
`c` b
b2
liftEq a -> b -> Bool
_ (EIncl Text
a) (EIncl Text
b) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b
liftEq a -> b -> Bool
_ ExpF a
_ ExpF b
_ = Bool
False
type Exp = Cofree ExpF
instance HasDelta (Exp Delta) where
delta :: Exp Delta -> Delta
delta = Exp Delta -> Delta
forall (w :: * -> *) a. Comonad w => w a -> a
Comonad.extract
fromValue :: Value -> Maybe (HashMap Text Value)
fromValue :: Value -> Maybe (HashMap Text Value)
fromValue (Object Object
o) = HashMap Text Value -> Maybe (HashMap Text Value)
forall a. a -> Maybe a
Just (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
toHashMapText Object
o)
fromValue Value
_ = Maybe (HashMap Text Value)
forall a. Maybe a
Nothing
fromPairs :: [Pair] -> HashMap Text Value
fromPairs :: [Pair] -> HashMap Text Value
fromPairs [Pair]
xs =
case [Pair] -> Value
Aeson.object [Pair]
xs of
Object Object
o -> Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
toHashMapText Object
o
Value
_other -> HashMap Text Value
forall a. Monoid a => a
mempty