{-# 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
-- Copyright   : (c) 2013-2020 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- /Warning/: this is an internal module, and does not have a stable
-- API or name. Functions in this module may not check or enforce
-- preconditions expected by public modules. Use at your own risk!
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 (Object, 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 Data.Text.Prettyprint.Doc (Doc, Pretty (..))
import qualified Data.Text.Prettyprint.Doc as PP
import qualified Data.Text.Prettyprint.Doc.Render.Terminal as PP
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

-- | Convenience wrapper for Pretty instances.
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"

-- | The result of running parsing or rendering steps.
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 a. a -> Result a
Success
  {-# 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 (m :: * -> *) a. Monad m => a -> m a
return
  {-# 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

-- | Convert a 'Result' to an 'Either' with the 'Left' case holding a
-- formatted error message, and 'Right' being the successful result over
-- which 'Result' is paramterised.
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

-- | Perform a case analysis on a 'Result'.
result ::
  -- | Function to apply to the 'Failure' case.
  (AnsiDoc -> b) ->
  -- | Function to apply to the 'Success' case.
  (a -> b) ->
  -- | The 'Result' to map over.
  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

-- | Convenience for returning a successful 'Result'.
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

-- | Convenience for returning an error 'Result'.
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,
    Syntax -> Delim
_delimComment :: !Delim,
    Syntax -> Delim
_delimBlock :: !Delim
  }

$(Lens.makeClassy ''Syntax)

-- | A function to resolve the target of an @include@ expression.
type Resolver m = Syntax -> Id -> Delta -> m (Result Template)

-- instance Applicative m => Semigroup (Resolver m) where
--   (f <> g) o k d = liftA2 (<|>) (f o k d) (g o k d) -- Haha!
--   {-# INLINE (<>) #-}

-- | A parsed and compiled 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

-- | Unwrap a 'Value' to an 'Object' safely.
--
-- See Aeson\'s documentation for more details.
fromValue :: Value -> Maybe Object
fromValue :: Value -> Maybe Object
fromValue (Object Object
o) = Object -> Maybe Object
forall a. a -> Maybe a
Just Object
o
fromValue Value
_ = Maybe Object
forall a. Maybe a
Nothing

-- | Create an 'Object' from a list of name/value 'Pair's.
--
-- See Aeson\'s documentation for more details.
fromPairs :: [Pair] -> Object
fromPairs :: [Pair] -> Object
fromPairs [Pair]
xs =
  case [Pair] -> Value
Aeson.object [Pair]
xs of
    Object Object
o -> Object
o
    Value
_other -> Object
forall a. Monoid a => a
mempty