{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}
module Zinza.Node (
    Nodes,
    Node (..),
    (>>==),
    ) where

import Zinza.Expr
import Zinza.Pos
import Zinza.Var

-- | A list of 'Node's.
type Nodes a = [Node a]

-- | Template parts.
--
-- We use polymorphic recursion for de Bruijn indices.
-- See materials on @bound@ library.
--
data Node a
    = NRaw  String                           -- ^ raw text block
    | NExpr (LExpr a)                        -- ^ expression @expr : String@
    | NIf   (LExpr a) (Nodes a) (Nodes a)    -- ^ conditional block, @expr : Bool@
    | NFor  Var (LExpr a) (Nodes (Maybe a))  -- ^ for loop, @expr : List a@
    | NDefBlock Loc Var (Nodes a)            -- ^ define block
    | NUseBlock Loc Var                      -- ^ use block
    | NComment                               -- ^ comments
  deriving (Int -> Node a -> ShowS
[Node a] -> ShowS
Node a -> String
(Int -> Node a -> ShowS)
-> (Node a -> String) -> ([Node a] -> ShowS) -> Show (Node a)
forall a. Show a => Int -> Node a -> ShowS
forall a. Show a => [Node a] -> ShowS
forall a. Show a => Node a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Node a -> ShowS
showsPrec :: Int -> Node a -> ShowS
$cshow :: forall a. Show a => Node a -> String
show :: Node a -> String
$cshowList :: forall a. Show a => [Node a] -> ShowS
showList :: [Node a] -> ShowS
Show, (forall a b. (a -> b) -> Node a -> Node b)
-> (forall a b. a -> Node b -> Node a) -> Functor Node
forall a b. a -> Node b -> Node a
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Node a -> Node b
fmap :: forall a b. (a -> b) -> Node a -> Node b
$c<$ :: forall a b. a -> Node b -> Node a
<$ :: forall a b. a -> Node b -> Node a
Functor, (forall m. Monoid m => Node m -> m)
-> (forall m a. Monoid m => (a -> m) -> Node a -> m)
-> (forall m a. Monoid m => (a -> m) -> Node a -> m)
-> (forall a b. (a -> b -> b) -> b -> Node a -> b)
-> (forall a b. (a -> b -> b) -> b -> Node a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node a -> b)
-> (forall a. (a -> a -> a) -> Node a -> a)
-> (forall a. (a -> a -> a) -> Node a -> a)
-> (forall a. Node a -> [a])
-> (forall a. Node a -> Bool)
-> (forall a. Node a -> Int)
-> (forall a. Eq a => a -> Node a -> Bool)
-> (forall a. Ord a => Node a -> a)
-> (forall a. Ord a => Node a -> a)
-> (forall a. Num a => Node a -> a)
-> (forall a. Num a => Node a -> a)
-> Foldable Node
forall a. Eq a => a -> Node a -> Bool
forall a. Num a => Node a -> a
forall a. Ord a => Node a -> a
forall m. Monoid m => Node m -> m
forall a. Node a -> Bool
forall a. Node a -> Int
forall a. Node a -> [a]
forall a. (a -> a -> a) -> Node a -> a
forall m a. Monoid m => (a -> m) -> Node a -> m
forall b a. (b -> a -> b) -> b -> Node a -> b
forall a b. (a -> b -> b) -> b -> Node 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
$cfold :: forall m. Monoid m => Node m -> m
fold :: forall m. Monoid m => Node m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Node a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Node a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Node a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Node a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Node a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Node a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Node a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Node a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Node a -> a
foldr1 :: forall a. (a -> a -> a) -> Node a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Node a -> a
foldl1 :: forall a. (a -> a -> a) -> Node a -> a
$ctoList :: forall a. Node a -> [a]
toList :: forall a. Node a -> [a]
$cnull :: forall a. Node a -> Bool
null :: forall a. Node a -> Bool
$clength :: forall a. Node a -> Int
length :: forall a. Node a -> Int
$celem :: forall a. Eq a => a -> Node a -> Bool
elem :: forall a. Eq a => a -> Node a -> Bool
$cmaximum :: forall a. Ord a => Node a -> a
maximum :: forall a. Ord a => Node a -> a
$cminimum :: forall a. Ord a => Node a -> a
minimum :: forall a. Ord a => Node a -> a
$csum :: forall a. Num a => Node a -> a
sum :: forall a. Num a => Node a -> a
$cproduct :: forall a. Num a => Node a -> a
product :: forall a. Num a => Node a -> a
Foldable, Functor Node
Foldable Node
(Functor Node, Foldable Node) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Node a -> f (Node b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Node (f a) -> f (Node a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Node a -> m (Node b))
-> (forall (m :: * -> *) a. Monad m => Node (m a) -> m (Node a))
-> Traversable Node
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 => Node (m a) -> m (Node a)
forall (f :: * -> *) a. Applicative f => Node (f a) -> f (Node a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node a -> m (Node b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Node (f a) -> f (Node a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Node (f a) -> f (Node a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node a -> m (Node b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node a -> m (Node b)
$csequence :: forall (m :: * -> *) a. Monad m => Node (m a) -> m (Node a)
sequence :: forall (m :: * -> *) a. Monad m => Node (m a) -> m (Node a)
Traversable)

instance TraversableWithLoc Node where
    traverseWithLoc :: forall (f :: * -> *) a b.
Applicative f =>
(Loc -> a -> f b) -> Node a -> f (Node b)
traverseWithLoc Loc -> a -> f b
_ Node a
NComment   = Node b -> f (Node b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node b
forall a. Node a
NComment
    traverseWithLoc Loc -> a -> f b
_ (NRaw String
s)   = Node b -> f (Node b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Node b
forall a. String -> Node a
NRaw String
s)
    traverseWithLoc Loc -> a -> f b
f (NExpr LExpr a
e)  = LExpr b -> Node b
forall a. LExpr a -> Node a
NExpr
        (LExpr b -> Node b) -> f (LExpr b) -> f (Node b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr a -> f (Expr b)) -> LExpr a -> f (LExpr b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
traverse ((Loc -> a -> f b) -> Expr a -> f (Expr b)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithLoc t, Applicative f) =>
(Loc -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Loc -> a -> f b) -> Expr a -> f (Expr b)
traverseWithLoc Loc -> a -> f b
f) LExpr a
e
    traverseWithLoc Loc -> a -> f b
f (NIf LExpr a
e Nodes a
xs Nodes a
ys) = LExpr b -> Nodes b -> Nodes b -> Node b
forall a. LExpr a -> Nodes a -> Nodes a -> Node a
NIf
        (LExpr b -> Nodes b -> Nodes b -> Node b)
-> f (LExpr b) -> f (Nodes b -> Nodes b -> Node b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr a -> f (Expr b)) -> LExpr a -> f (LExpr b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
traverse ((Loc -> a -> f b) -> Expr a -> f (Expr b)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithLoc t, Applicative f) =>
(Loc -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Loc -> a -> f b) -> Expr a -> f (Expr b)
traverseWithLoc Loc -> a -> f b
f) LExpr a
e
        f (Nodes b -> Nodes b -> Node b)
-> f (Nodes b) -> f (Nodes b -> Node b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node a -> f (Node b)) -> Nodes a -> f (Nodes b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Loc -> a -> f b) -> Node a -> f (Node b)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithLoc t, Applicative f) =>
(Loc -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Loc -> a -> f b) -> Node a -> f (Node b)
traverseWithLoc Loc -> a -> f b
f) Nodes a
xs
        f (Nodes b -> Node b) -> f (Nodes b) -> f (Node b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node a -> f (Node b)) -> Nodes a -> f (Nodes b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Loc -> a -> f b) -> Node a -> f (Node b)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithLoc t, Applicative f) =>
(Loc -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Loc -> a -> f b) -> Node a -> f (Node b)
traverseWithLoc Loc -> a -> f b
f) Nodes a
ys
    traverseWithLoc Loc -> a -> f b
f (NFor String
v LExpr a
e Nodes (Maybe a)
ns) = String -> LExpr b -> Nodes (Maybe b) -> Node b
forall a. String -> LExpr a -> Nodes (Maybe a) -> Node a
NFor String
v
        (LExpr b -> Nodes (Maybe b) -> Node b)
-> f (LExpr b) -> f (Nodes (Maybe b) -> Node b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr a -> f (Expr b)) -> LExpr a -> f (LExpr b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located a -> f (Located b)
traverse ((Loc -> a -> f b) -> Expr a -> f (Expr b)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithLoc t, Applicative f) =>
(Loc -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Loc -> a -> f b) -> Expr a -> f (Expr b)
traverseWithLoc Loc -> a -> f b
f) LExpr a
e
        f (Nodes (Maybe b) -> Node b) -> f (Nodes (Maybe b)) -> f (Node b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node (Maybe a) -> f (Node (Maybe b)))
-> Nodes (Maybe a) -> f (Nodes (Maybe b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Loc -> Maybe a -> f (Maybe b))
-> Node (Maybe a) -> f (Node (Maybe b))
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithLoc t, Applicative f) =>
(Loc -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Loc -> a -> f b) -> Node a -> f (Node b)
traverseWithLoc Loc -> Maybe a -> f (Maybe b)
f') Nodes (Maybe a)
ns
      where
        f' :: Loc -> Maybe a -> f (Maybe b)
f' Loc
_ Maybe a
Nothing  = Maybe b -> f (Maybe b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
        f' Loc
l (Just a
x) = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> f b -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Loc -> a -> f b
f Loc
l a
x
    traverseWithLoc Loc -> a -> f b
f (NDefBlock Loc
l String
n Nodes a
xs) = Loc -> String -> Nodes b -> Node b
forall a. Loc -> String -> Nodes a -> Node a
NDefBlock Loc
l String
n
        (Nodes b -> Node b) -> f (Nodes b) -> f (Node b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node a -> f (Node b)) -> Nodes a -> f (Nodes b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Loc -> a -> f b) -> Node a -> f (Node b)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithLoc t, Applicative f) =>
(Loc -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(Loc -> a -> f b) -> Node a -> f (Node b)
traverseWithLoc Loc -> a -> f b
f) Nodes a
xs
    traverseWithLoc Loc -> a -> f b
_ (NUseBlock Loc
l String
n) = Node b -> f (Node b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Loc -> String -> Node b
forall a. Loc -> String -> Node a
NUseBlock Loc
l String
n)

-- | Substitution.
(>>==) :: Node a -> (a -> Expr b) -> Node b
Node a
NComment               >>== :: forall a b. Node a -> (a -> Expr b) -> Node b
>>== a -> Expr b
_ = Node b
forall a. Node a
NComment
NRaw String
s                 >>== a -> Expr b
_ = String -> Node b
forall a. String -> Node a
NRaw String
s
NExpr (L Loc
l Expr a
expr)       >>== a -> Expr b
k = LExpr b -> Node b
forall a. LExpr a -> Node a
NExpr (Loc -> Expr b -> LExpr b
forall a. Loc -> a -> Located a
L Loc
l (Expr a
expr Expr a -> (a -> Expr b) -> Expr b
forall a b. Expr a -> (a -> Expr b) -> Expr b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Expr b
k))
NIf (L Loc
l Expr a
expr) Nodes a
xs Nodes a
ys   >>== a -> Expr b
k = LExpr b -> Nodes b -> Nodes b -> Node b
forall a. LExpr a -> Nodes a -> Nodes a -> Node a
NIf (Loc -> Expr b -> LExpr b
forall a. Loc -> a -> Located a
L Loc
l (Expr a
expr Expr a -> (a -> Expr b) -> Expr b
forall a b. Expr a -> (a -> Expr b) -> Expr b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Expr b
k)) ((Node a -> Node b) -> Nodes a -> Nodes b
forall a b. (a -> b) -> [a] -> [b]
map (Node a -> (a -> Expr b) -> Node b
forall a b. Node a -> (a -> Expr b) -> Node b
>>== a -> Expr b
k) Nodes a
xs) ((Node a -> Node b) -> Nodes a -> Nodes b
forall a b. (a -> b) -> [a] -> [b]
map (Node a -> (a -> Expr b) -> Node b
forall a b. Node a -> (a -> Expr b) -> Node b
>>== a -> Expr b
k) Nodes a
ys)
NFor String
var (L Loc
l Expr a
expr) Nodes (Maybe a)
ns >>== a -> Expr b
k = String -> LExpr b -> Nodes (Maybe b) -> Node b
forall a. String -> LExpr a -> Nodes (Maybe a) -> Node a
NFor String
var (Loc -> Expr b -> LExpr b
forall a. Loc -> a -> Located a
L Loc
l (Expr a
expr Expr a -> (a -> Expr b) -> Expr b
forall a b. Expr a -> (a -> Expr b) -> Expr b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Expr b
k)) ((Node (Maybe a) -> Node (Maybe b))
-> Nodes (Maybe a) -> Nodes (Maybe b)
forall a b. (a -> b) -> [a] -> [b]
map (Node (Maybe a) -> (Maybe a -> Expr (Maybe b)) -> Node (Maybe b)
forall a b. Node a -> (a -> Expr b) -> Node b
>>== (a -> Expr b) -> Maybe a -> Expr (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse a -> Expr b
k) Nodes (Maybe a)
ns)
NDefBlock Loc
l String
n Nodes a
xs       >>== a -> Expr b
k = Loc -> String -> Nodes b -> Node b
forall a. Loc -> String -> Nodes a -> Node a
NDefBlock Loc
l String
n ((Node a -> Node b) -> Nodes a -> Nodes b
forall a b. (a -> b) -> [a] -> [b]
map (Node a -> (a -> Expr b) -> Node b
forall a b. Node a -> (a -> Expr b) -> Node b
>>== a -> Expr b
k) Nodes a
xs)
NUseBlock Loc
l String
n          >>== a -> Expr b
_ = Loc -> String -> Node b
forall a. Loc -> String -> Node a
NUseBlock Loc
l String
n