module Bricks.Expression.Construction
(
lambda
, apply
, var
, dot
, list
, let'in
, let'eq
, let'inherit'from
, dict
, rec'dict
, dict'eq
, dict'inherit'from
, dict'inherit
, str
, antiquote
, Str'1'IsString (..)
, str'indented
, indent
, Param'Builder (..)
, param
, pattern
, dict'param
, def
, ellipsis
, Expression
, (<>)
, (&)
, Maybe (Just, Nothing)
) where
import Bricks.Expression
import Bricks.UnquotedString
import Bricks.Internal.Prelude
import qualified Bricks.Internal.Seq as Seq
import Bricks.Internal.Text (Text)
import qualified Bricks.Internal.Text as Text
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.String (IsString (fromString))
lambda :: Param'Builder -> Expression -> Expression
lambda a b =
Expr'Lambda $ Lambda (buildParam a) b Nothing
apply :: Expression -> Expression -> Expression
apply a b =
Expr'Apply $ Apply a b Nothing
var :: Text -> Expression
var x =
Expr'Var $ Var (unquotedString'orThrow x) Nothing
dot :: Expression -> Expression -> Expression
dot a b =
Expr'Dot $ Dot a b Nothing
list :: [Expression] -> Expression
list x =
Expr'List $ List (Seq.fromList x) Nothing
let'in :: [LetBinding] -> Expression -> Expression
let'in a b =
Expr'Let $ Let (Seq.fromList a) b Nothing
let'eq :: Text -> Expression -> LetBinding
let'eq a b =
LetBinding'Eq (Var (unquotedString'orThrow a) Nothing) b
let'inherit'from :: Expression -> [Text] -> LetBinding
let'inherit'from a b =
LetBinding'Inherit
a
(Seq.fromList $ fmap (\x -> Var (unquotedString'orThrow x) Nothing) b)
dict :: [DictBinding] -> Expression
dict x =
Expr'Dict $ Dict False (Seq.fromList x) Nothing
rec'dict :: [DictBinding] -> Expression
rec'dict x =
Expr'Dict $ Dict False (Seq.fromList x) Nothing
dict'eq :: Expression -> Expression -> DictBinding
dict'eq =
DictBinding'Eq
dict'inherit'from :: Expression -> [Text] -> DictBinding
dict'inherit'from a b =
DictBinding'Inherit'Dict
a
(Seq.fromList (fmap (\x -> Str'Static x Nothing) b))
dict'inherit :: [Text] -> DictBinding
dict'inherit a =
DictBinding'Inherit'Var
(Seq.fromList $ fmap (\x -> Var (unquotedString'orThrow x) Nothing) a)
str :: [Str'1'IsString] -> Expression
str xs =
Expr'Str $ Str'Dynamic (Seq.fromList (fmap unStr'1'IsString xs)) Nothing
antiquote :: Expression -> Str'1'IsString
antiquote =
Str'1'IsString . Str'1'Antiquote
newtype Str'1'IsString = Str'1'IsString { unStr'1'IsString :: Str'1 }
instance IsString Str'1'IsString
where
fromString x =
Str'1'IsString . Str'1'Literal $ Str'Static (Text.pack x) Nothing
str'indented :: [InStr'1] -> Expression
str'indented xs =
Expr'Str'Indented $ InStr (Seq.fromList xs) Nothing
indent :: Natural -> [Str'1'IsString] -> Maybe Text -> InStr'1
indent n xs lbr =
InStr'1
n
Nothing
(Seq.fromList (fmap unStr'1'IsString xs))
(fmap (\x -> Str'Static x Nothing) lbr)
newtype Param'Builder = Param'Builder (NonEmpty Param)
deriving Semigroup
paramBuilder :: Param -> Param'Builder
paramBuilder x =
Param'Builder (x :| [])
param :: Text -> Param'Builder
param x =
paramBuilder . Param'Name $ Var (unquotedString'orThrow x) Nothing
buildParam :: Param'Builder -> Param
buildParam (Param'Builder xs) =
foldr1 mergeParams xs
pattern :: [DictPattern'1] -> Param'Builder
pattern xs =
paramBuilder $ Param'DictPattern $ DictPattern (Seq.fromList xs) False
dict'param :: Text -> DictPattern'1
dict'param x =
Bricks.Expression.DictPattern'1
(Var (unquotedString'orThrow x) Nothing)
Nothing
def :: Expression -> DictPattern'1 -> DictPattern'1
def b (DictPattern'1 a _) =
DictPattern'1 a (Just b)
ellipsis :: Param'Builder
ellipsis =
paramBuilder $ Param'DictPattern $ DictPattern Seq.empty True
mergeParams :: Param -> Param -> Param
mergeParams = (+)
where
(+) :: Param -> Param -> Param
Param'Both _n1 p1 + Param'Name n2 = Param'Both n2 p1
Param'Name n + Param'DictPattern p = Param'Both n p
Param'DictPattern p + Param'Name n = Param'Both n p
Param'Name _n + x = x
Param'DictPattern p1 + Param'DictPattern p2 =
Param'DictPattern (mergeDictPatterns p1 p2)
Param'DictPattern p1 + Param'Both n p2 =
Param'Both n (mergeDictPatterns p1 p2)
Param'Both _n1 p1 + Param'Both n2 p2 =
Param'Both n2 (mergeDictPatterns p1 p2)
Param'Both n p1 + Param'DictPattern p2 =
Param'Both n (mergeDictPatterns p1 p2)
mergeDictPatterns :: DictPattern -> DictPattern -> DictPattern
mergeDictPatterns = (+)
where
DictPattern xs1 e1 + DictPattern xs2 e2 =
DictPattern (xs1 <> xs2) (e1 || e2)