{-# OPTIONS_GHC -fwarn-unused-imports -fwarn-incomplete-patterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
module Text.HSmarty.Types where

import qualified Data.Aeson as A
import qualified Data.Text as T

data Smarty
   = Smarty
   { Smarty -> FilePath
s_name :: FilePath
   , Smarty -> [SmartyStmt]
s_template :: [ SmartyStmt ]
   } deriving (Smarty -> Smarty -> Bool
(Smarty -> Smarty -> Bool)
-> (Smarty -> Smarty -> Bool) -> Eq Smarty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Smarty -> Smarty -> Bool
$c/= :: Smarty -> Smarty -> Bool
== :: Smarty -> Smarty -> Bool
$c== :: Smarty -> Smarty -> Bool
Eq, Int -> Smarty -> ShowS
[Smarty] -> ShowS
Smarty -> FilePath
(Int -> Smarty -> ShowS)
-> (Smarty -> FilePath) -> ([Smarty] -> ShowS) -> Show Smarty
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Smarty] -> ShowS
$cshowList :: [Smarty] -> ShowS
show :: Smarty -> FilePath
$cshow :: Smarty -> FilePath
showsPrec :: Int -> Smarty -> ShowS
$cshowsPrec :: Int -> Smarty -> ShowS
Show)

type PrintDirective = T.Text

data SmartyStmt
   = SmartyText T.Text
   | SmartyComment T.Text
   | SmartyIf If
   | SmartyForeach Foreach
   | SmartyCapture Capture
   | SmartyLet Let
   | SmartyPrint Expr [ PrintDirective ]
   | SmartyScope Scope
   | SmartyFun FunctionDef
   deriving (SmartyStmt -> SmartyStmt -> Bool
(SmartyStmt -> SmartyStmt -> Bool)
-> (SmartyStmt -> SmartyStmt -> Bool) -> Eq SmartyStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmartyStmt -> SmartyStmt -> Bool
$c/= :: SmartyStmt -> SmartyStmt -> Bool
== :: SmartyStmt -> SmartyStmt -> Bool
$c== :: SmartyStmt -> SmartyStmt -> Bool
Eq, Int -> SmartyStmt -> ShowS
[SmartyStmt] -> ShowS
SmartyStmt -> FilePath
(Int -> SmartyStmt -> ShowS)
-> (SmartyStmt -> FilePath)
-> ([SmartyStmt] -> ShowS)
-> Show SmartyStmt
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SmartyStmt] -> ShowS
$cshowList :: [SmartyStmt] -> ShowS
show :: SmartyStmt -> FilePath
$cshow :: SmartyStmt -> FilePath
showsPrec :: Int -> SmartyStmt -> ShowS
$cshowsPrec :: Int -> SmartyStmt -> ShowS
Show)

data Expr
   = ExprVar Variable
   | ExprLit A.Value
   | ExprFun FunctionCall
   | ExprBin BinOp
   deriving (Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> FilePath
(Int -> Expr -> ShowS)
-> (Expr -> FilePath) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> FilePath
$cshow :: Expr -> FilePath
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show)

data Variable
   = Variable
   { Variable -> Text
v_name :: T.Text
   , Variable -> [Text]
v_path :: [T.Text]
   , Variable -> Maybe Expr
v_index :: Maybe Expr
   , Variable -> Maybe Text
v_prop :: Maybe T.Text
   }
   deriving (Variable -> Variable -> Bool
(Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool) -> Eq Variable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Variable -> Variable -> Bool
$c/= :: Variable -> Variable -> Bool
== :: Variable -> Variable -> Bool
$c== :: Variable -> Variable -> Bool
Eq, Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> FilePath
(Int -> Variable -> ShowS)
-> (Variable -> FilePath) -> ([Variable] -> ShowS) -> Show Variable
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Variable] -> ShowS
$cshowList :: [Variable] -> ShowS
show :: Variable -> FilePath
$cshow :: Variable -> FilePath
showsPrec :: Int -> Variable -> ShowS
$cshowsPrec :: Int -> Variable -> ShowS
Show)

data FunctionCall
   = FunctionCall
   { FunctionCall -> Text
f_name :: T.Text
   , FunctionCall -> [(Text, Expr)]
f_args :: [ (T.Text, Expr) ]
   }
   deriving (FunctionCall -> FunctionCall -> Bool
(FunctionCall -> FunctionCall -> Bool)
-> (FunctionCall -> FunctionCall -> Bool) -> Eq FunctionCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionCall -> FunctionCall -> Bool
$c/= :: FunctionCall -> FunctionCall -> Bool
== :: FunctionCall -> FunctionCall -> Bool
$c== :: FunctionCall -> FunctionCall -> Bool
Eq, Int -> FunctionCall -> ShowS
[FunctionCall] -> ShowS
FunctionCall -> FilePath
(Int -> FunctionCall -> ShowS)
-> (FunctionCall -> FilePath)
-> ([FunctionCall] -> ShowS)
-> Show FunctionCall
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FunctionCall] -> ShowS
$cshowList :: [FunctionCall] -> ShowS
show :: FunctionCall -> FilePath
$cshow :: FunctionCall -> FilePath
showsPrec :: Int -> FunctionCall -> ShowS
$cshowsPrec :: Int -> FunctionCall -> ShowS
Show)

data BinOp
   = BinEq Expr Expr
   | BinNot Expr
   | BinAnd Expr Expr
   | BinOr Expr Expr
   | BinLarger Expr Expr
   | BinSmaller Expr Expr
   | BinLargerEq Expr Expr
   | BinSmallerEq Expr Expr
   | BinPlus Expr Expr
   | BinMinus Expr Expr
   | BinMul Expr Expr
   | BinDiv Expr Expr
   deriving (BinOp -> BinOp -> Bool
(BinOp -> BinOp -> Bool) -> (BinOp -> BinOp -> Bool) -> Eq BinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c== :: BinOp -> BinOp -> Bool
Eq, Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> FilePath
(Int -> BinOp -> ShowS)
-> (BinOp -> FilePath) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BinOp] -> ShowS
$cshowList :: [BinOp] -> ShowS
show :: BinOp -> FilePath
$cshow :: BinOp -> FilePath
showsPrec :: Int -> BinOp -> ShowS
$cshowsPrec :: Int -> BinOp -> ShowS
Show)

data Let
    = Let
    { Let -> Text
l_name :: T.Text
    , Let -> Expr
l_expr :: Expr
    } deriving (Int -> Let -> ShowS
[Let] -> ShowS
Let -> FilePath
(Int -> Let -> ShowS)
-> (Let -> FilePath) -> ([Let] -> ShowS) -> Show Let
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Let] -> ShowS
$cshowList :: [Let] -> ShowS
show :: Let -> FilePath
$cshow :: Let -> FilePath
showsPrec :: Int -> Let -> ShowS
$cshowsPrec :: Int -> Let -> ShowS
Show, Let -> Let -> Bool
(Let -> Let -> Bool) -> (Let -> Let -> Bool) -> Eq Let
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Let -> Let -> Bool
$c/= :: Let -> Let -> Bool
== :: Let -> Let -> Bool
$c== :: Let -> Let -> Bool
Eq)

data Scope
    = Scope
    { Scope -> [SmartyStmt]
s_stmts :: [SmartyStmt]
    } deriving (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> FilePath
(Int -> Scope -> ShowS)
-> (Scope -> FilePath) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> FilePath
$cshow :: Scope -> FilePath
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq)

data Capture
    = Capture
    { Capture -> Text
c_name :: T.Text
    , Capture -> Maybe Text
c_assign :: Maybe T.Text
    , Capture -> [SmartyStmt]
c_stmts :: [SmartyStmt]
    } deriving (Int -> Capture -> ShowS
[Capture] -> ShowS
Capture -> FilePath
(Int -> Capture -> ShowS)
-> (Capture -> FilePath) -> ([Capture] -> ShowS) -> Show Capture
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Capture] -> ShowS
$cshowList :: [Capture] -> ShowS
show :: Capture -> FilePath
$cshow :: Capture -> FilePath
showsPrec :: Int -> Capture -> ShowS
$cshowsPrec :: Int -> Capture -> ShowS
Show, Capture -> Capture -> Bool
(Capture -> Capture -> Bool)
-> (Capture -> Capture -> Bool) -> Eq Capture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Capture -> Capture -> Bool
$c/= :: Capture -> Capture -> Bool
== :: Capture -> Capture -> Bool
$c== :: Capture -> Capture -> Bool
Eq)

data FunctionDef
    = FunctionDef
    { FunctionDef -> Text
fd_name :: T.Text
    , FunctionDef -> [(Text, Expr)]
fd_defArgs :: [(T.Text, Expr)]
    , FunctionDef -> [SmartyStmt]
fd_body :: [SmartyStmt]
    } deriving (Int -> FunctionDef -> ShowS
[FunctionDef] -> ShowS
FunctionDef -> FilePath
(Int -> FunctionDef -> ShowS)
-> (FunctionDef -> FilePath)
-> ([FunctionDef] -> ShowS)
-> Show FunctionDef
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FunctionDef] -> ShowS
$cshowList :: [FunctionDef] -> ShowS
show :: FunctionDef -> FilePath
$cshow :: FunctionDef -> FilePath
showsPrec :: Int -> FunctionDef -> ShowS
$cshowsPrec :: Int -> FunctionDef -> ShowS
Show, FunctionDef -> FunctionDef -> Bool
(FunctionDef -> FunctionDef -> Bool)
-> (FunctionDef -> FunctionDef -> Bool) -> Eq FunctionDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionDef -> FunctionDef -> Bool
$c/= :: FunctionDef -> FunctionDef -> Bool
== :: FunctionDef -> FunctionDef -> Bool
$c== :: FunctionDef -> FunctionDef -> Bool
Eq)

data If
   = If
   { If -> [(Expr, [SmartyStmt])]
if_cases :: [ (Expr, [SmartyStmt]) ]
   , If -> Maybe [SmartyStmt]
if_else :: Maybe [SmartyStmt]
   }
   deriving (If -> If -> Bool
(If -> If -> Bool) -> (If -> If -> Bool) -> Eq If
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: If -> If -> Bool
$c/= :: If -> If -> Bool
== :: If -> If -> Bool
$c== :: If -> If -> Bool
Eq, Int -> If -> ShowS
[If] -> ShowS
If -> FilePath
(Int -> If -> ShowS)
-> (If -> FilePath) -> ([If] -> ShowS) -> Show If
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [If] -> ShowS
$cshowList :: [If] -> ShowS
show :: If -> FilePath
$cshow :: If -> FilePath
showsPrec :: Int -> If -> ShowS
$cshowsPrec :: Int -> If -> ShowS
Show)

data Foreach
   = Foreach
   { Foreach -> Expr
f_source :: Expr
   , Foreach -> Maybe Text
f_key :: Maybe T.Text
   , Foreach -> Text
f_item :: T.Text
   , Foreach -> [SmartyStmt]
f_body :: [SmartyStmt]
   , Foreach -> Maybe [SmartyStmt]
f_else :: Maybe [SmartyStmt]
   }
   deriving (Foreach -> Foreach -> Bool
(Foreach -> Foreach -> Bool)
-> (Foreach -> Foreach -> Bool) -> Eq Foreach
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Foreach -> Foreach -> Bool
$c/= :: Foreach -> Foreach -> Bool
== :: Foreach -> Foreach -> Bool
$c== :: Foreach -> Foreach -> Bool
Eq, Int -> Foreach -> ShowS
[Foreach] -> ShowS
Foreach -> FilePath
(Int -> Foreach -> ShowS)
-> (Foreach -> FilePath) -> ([Foreach] -> ShowS) -> Show Foreach
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Foreach] -> ShowS
$cshowList :: [Foreach] -> ShowS
show :: Foreach -> FilePath
$cshow :: Foreach -> FilePath
showsPrec :: Int -> Foreach -> ShowS
$cshowsPrec :: Int -> Foreach -> ShowS
Show)