ede 0.3.0.0 → 0.3.1.0
raw patch · 22 files changed
+2673/−2549 lines, 22 filesdep −double-conversiondep −semigroupsdep ~bifunctors
Dependencies removed: double-conversion, semigroups
Dependency ranges changed: bifunctors
Files
- app/Main.hs +136/−0
- app/ede.hs +0/−138
- ede.cabal +26/−27
- lib/Text/EDE.hs +698/−0
- lib/Text/EDE/Filters.hs +220/−0
- lib/Text/EDE/Internal/AST.hs +96/−0
- lib/Text/EDE/Internal/Eval.hs +240/−0
- lib/Text/EDE/Internal/Filters.hs +196/−0
- lib/Text/EDE/Internal/Parser.hs +433/−0
- lib/Text/EDE/Internal/Quoting.hs +226/−0
- lib/Text/EDE/Internal/Syntax.hs +123/−0
- lib/Text/EDE/Internal/Types.hs +242/−0
- src/Text/EDE.hs +0/−698
- src/Text/EDE/Filters.hs +0/−219
- src/Text/EDE/Internal/AST.hs +0/−74
- src/Text/EDE/Internal/Eval.hs +0/−222
- src/Text/EDE/Internal/Filters.hs +0/−196
- src/Text/EDE/Internal/Parser.hs +0/−388
- src/Text/EDE/Internal/Quoting.hs +0/−213
- src/Text/EDE/Internal/Syntax.hs +0/−113
- src/Text/EDE/Internal/Types.hs +0/−231
- test/Main.hs +37/−30
+ app/Main.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import qualified Control.Monad.Fail as Fail+import qualified Data.Aeson as Aeson+import qualified Data.Attoparsec.ByteString as Parsec+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as ByteString.Lazy+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text.Encoding+import qualified Data.Text.Lazy.IO as Text.Lazy.IO+import qualified Options.Applicative as Options+import qualified Options.Applicative.Help.Pretty as Pretty+import qualified System.Exit as Exit+import qualified Text.EDE as EDE++data Options = Options+ { templateFile :: FilePath,+ jsonFile :: Maybe FilePath,+ jsonObject :: Maybe Aeson.Object+ }++optionsParser :: Options.Parser Options+optionsParser =+ Options+ <$> Options.strOption+ ( Options.long "template-file"+ <> Options.metavar "PATH"+ <> Options.help+ "Path of a file containing an EDE template"+ )+ <*> Options.optional+ ( Options.strOption+ ( Options.long "context-file"+ <> Options.metavar "PATH"+ <> Options.help+ "Path of a file containing a JSON object which is used \+ \as the template context"+ )+ )+ <*> Options.optional+ ( Options.option+ readObject+ ( Options.long "context-json"+ <> Options.metavar "OBJECT"+ <> Options.help+ "Template context as a JSON object"+ )+ )++parserInfo :: Options.ParserInfo Options+parserInfo =+ Options.info+ (Options.helper <*> optionsParser)+ (Options.header "EDE template processor" <> Options.progDescDoc (Just usage))+ where+ usage =+ Pretty.vcat+ [ Pretty.empty,+ "The --context-file and --context-json options are processed as follows:",+ Pretty.indent 2 "1.)"+ Pretty.<+> ( Pretty.align+ ( "Both are provided"+ Pretty.<$$> "Both objects are merged into one with the keys of \+ \--context-json taking precedence over those in the \+ \file provided by --context-file."+ )+ ),+ Pretty.indent 2 "2.)"+ Pretty.<+> ( Pretty.align+ ( "None of them are provided"+ Pretty.<$$> "The JSON object is read from STDIN."+ )+ ),+ Pretty.indent 2 "3.)"+ Pretty.<+> ( Pretty.align+ ( "One of them is provided"+ Pretty.<$$> "The JSON object is read from the supplied option."+ )+ )+ ]++main :: IO ()+main = do+ options <- Options.execParser parserInfo++ ctx <-+ case (jsonFile options, jsonObject options) of+ (Just path, Just obj1) -> do+ eobj2 <- Aeson.eitherDecode <$> ByteString.Lazy.readFile path++ case eobj2 of+ Left err -> fail err+ Right obj2 -> pure (obj1 <> obj2)+ --+ (Just path, Nothing) -> do+ eobj <- Aeson.eitherDecode <$> ByteString.Lazy.readFile path+ case eobj of+ Left err -> fail err+ Right obj -> pure obj+ --+ (Nothing, Just obj) ->+ pure obj+ --+ (Nothing, Nothing) ->+ ByteString.getContents+ >>= either fail pure . Parsec.parseOnly stdinParser++ EDE.parseFile (templateFile options) >>= \case+ EDE.Failure err -> print err >> Exit.exitFailure+ EDE.Success tpl ->+ case EDE.render tpl ctx of+ EDE.Failure err -> print err >> Exit.exitFailure+ EDE.Success output -> Text.Lazy.IO.putStr output++stdinParser :: Parsec.Parser Aeson.Object+stdinParser = Aeson.json >>= requireObject++readValue :: Options.ReadM Aeson.Value+readValue = Options.str >>= decodeJsonStr++decodeJsonStr :: Fail.MonadFail m => String -> m Aeson.Value+decodeJsonStr =+ either fail pure . Aeson.eitherDecode . ByteString.Lazy.fromStrict+ . Text.Encoding.encodeUtf8+ . Text.pack++readObject :: Options.ReadM Aeson.Object+readObject = readValue >>= requireObject++requireObject :: Fail.MonadFail m => Aeson.Value -> m Aeson.Object+requireObject = \case+ Aeson.Object obj -> pure obj+ _ -> fail "JSON value must be an object"
− app/ede.hs
@@ -1,138 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}--module Main (main) where--import Control.Applicative ((<*>))-import qualified Data.Aeson as Aeson-import qualified Data.Attoparsec.ByteString as Parsec-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Lazy as ByteString.Lazy-import Data.Functor ((<$>))-import Data.Semigroup ((<>))-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text.Encoding-import qualified Data.Text.Lazy.IO as Text.Lazy.IO-import qualified Options.Applicative as Options-import qualified Options.Applicative.Help.Pretty as Pretty-import qualified System.Exit as Exit-import qualified Text.EDE as EDE--data Options = Options- { templateFile :: FilePath,- jsonFile :: Maybe FilePath,- jsonObject :: Maybe Aeson.Object- }--optionsParser :: Options.Parser Options-optionsParser =- Options- <$> Options.strOption- ( Options.long "template-file"- <> Options.metavar "PATH"- <> Options.help- "Path of a file containing an EDE template"- )- <*> Options.optional- ( Options.strOption- ( Options.long "context-file"- <> Options.metavar "PATH"- <> Options.help- "Path of a file containing a JSON object which is used \- \as the template context"- )- )- <*> Options.optional- ( Options.option- readObject- ( Options.long "context-json"- <> Options.metavar "OBJECT"- <> Options.help- "Template context as a JSON object"- )- )--parserInfo :: Options.ParserInfo Options-parserInfo =- Options.info- (Options.helper <*> optionsParser)- (Options.header "EDE template processor" <> Options.progDescDoc (Just usage))- where- usage =- Pretty.vcat- [ Pretty.empty,- "The --context-file and --context-json options are processed as follows:",- Pretty.indent 2 "1.)"- Pretty.<+> ( Pretty.align- ( "Both are provided"- Pretty.<$$> "Both objects are merged into one with the keys of \- \--context-json taking precedence over those in the \- \file provided by --context-file."- )- ),- Pretty.indent 2 "2.)"- Pretty.<+> ( Pretty.align- ( "None of them are provided"- Pretty.<$$> "The JSON object is read from STDIN."- )- ),- Pretty.indent 2 "3.)"- Pretty.<+> ( Pretty.align- ( "One of them is provided"- Pretty.<$$> "The JSON object is read from the supplied option."- )- )- ]--main :: IO ()-main = do- options <- Options.execParser parserInfo-- ctx <-- case (jsonFile options, jsonObject options) of- (Just path, Just obj1) -> do- eobj2 <- Aeson.eitherDecode <$> ByteString.Lazy.readFile path-- case eobj2 of- Left err -> fail err- Right obj2 -> pure (obj1 <> obj2)- --- (Just path, Nothing) -> do- eobj <- Aeson.eitherDecode <$> ByteString.Lazy.readFile path- case eobj of- Left err -> fail err- Right obj -> pure obj- --- (Nothing, Just obj) ->- pure obj- --- (Nothing, Nothing) ->- ByteString.getContents- >>= either fail pure . Parsec.parseOnly stdinParser-- EDE.parseFile (templateFile options) >>= \case- EDE.Failure err -> print err >> Exit.exitFailure- EDE.Success tpl ->- case EDE.render tpl ctx of- EDE.Failure err -> print err >> Exit.exitFailure- EDE.Success output -> Text.Lazy.IO.putStr output--stdinParser :: Parsec.Parser Aeson.Object-stdinParser = Aeson.json >>= requireObject--readValue :: Options.ReadM Aeson.Value-readValue = Options.str >>= decodeJsonStr--decodeJsonStr :: Monad m => String -> m Aeson.Value-decodeJsonStr =- either fail pure . Aeson.eitherDecode . ByteString.Lazy.fromStrict- . Text.Encoding.encodeUtf8- . Text.pack--readObject :: Options.ReadM Aeson.Object-readObject = readValue >>= requireObject--requireObject :: Monad m => Aeson.Value -> m Aeson.Object-requireObject = \case- Aeson.Object obj -> pure obj- _ -> fail "JSON value must be an object"
ede.cabal view
@@ -1,5 +1,6 @@+cabal-version: 2.2 name: ede-version: 0.3.0.0+version: 0.3.1.0 synopsis: Templating language with similar syntax and features to Liquid or Jinja2. @@ -12,7 +13,6 @@ stability: Experimental category: Text, Template, Web build-type: Simple-cabal-version: 2.0 description: ED-E is a templating language written in Haskell with a specific set of features: .@@ -45,14 +45,22 @@ type: git location: git://github.com/brendanhay/ede.git -library+common base default-language: Haskell2010- hs-source-dirs: src+ ghc-options:+ -Wall -funbox-strict-fields -fwarn-incomplete-uni-patterns+ -fwarn-incomplete-record-updates++ build-depends: base >=4.12 && <5+ autogen-modules: Paths_ede+ other-modules: Paths_ede++library+ import: base+ hs-source-dirs: lib exposed-modules: Text.EDE Text.EDE.Filters-- other-modules: Text.EDE.Internal.AST Text.EDE.Internal.Eval Text.EDE.Internal.Filters@@ -61,15 +69,11 @@ Text.EDE.Internal.Syntax Text.EDE.Internal.Types - ghc-options: -Wall build-depends:- aeson >=0.7- , base >=4.12 && <5- , bifunctors >=4+ , aeson >=0.7 , bytestring >=0.9 , comonad >=4.2 , directory >=1.2- , double-conversion >=2.0.2 , filepath >=1.2 , free >=4.8 , lens >=4.0@@ -78,7 +82,6 @@ , prettyprinter >=1.6 , prettyprinter-ansi-terminal >=1.1 , scientific >=0.3.1- , semigroups >=0.15 , text >=1.2 , text-manipulate >=0.1.2 , trifecta >=2.1@@ -86,30 +89,26 @@ , vector >=0.7.1 executable ede- default-language: Haskell2010- hs-source-dirs: app- main-is: ede.hs- ghc-options: -Wall+ import: base+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-A128m build-depends:- aeson >=0.8+ , aeson >=0.8 , attoparsec- , base >=4.12 && <5 , bytestring >=0.10.4 , ede , optparse-applicative >=0.11 , text >=1.2 test-suite golden- default-language: Haskell2010- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: Main.hs- other-modules: Paths_ede- autogen-modules: Paths_ede- ghc-options: -Wall -threaded+ import: base+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-A128m build-depends:- aeson- , base >=4.12 && <5+ , aeson , bifunctors , bytestring , directory
+ lib/Text/EDE.hs view
@@ -0,0 +1,698 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++-- |+-- Module : Text.EDE+-- 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)+--+-- A (mostly) logic-less textual templating language with similar syntax to+-- <https://github.com/Shopify/liquid Liquid> or <http://jinja.pocoo.org/docs/ Jinja2>.+--+-- (ED-E is a character from Fallout New Vegas, pronounced 'Eddie'.)+module Text.EDE+ ( -- * How to use this library+ -- $usage++ -- * Parsing and Rendering+ -- $parsing_and_rendering+ Template,++ -- ** Parsing+ parse,+ parseIO,+ parseFile,+ parseFileWith,+ parseWith,++ -- ** Includes+ -- $resolvers+ Resolver,+ Id,+ includeMap,+ includeFile,++ -- ** Rendering+ render,+ renderWith,++ -- ** Either Variants+ eitherParse,+ eitherParseFile,+ eitherParseWith,+ eitherRender,+ eitherRenderWith,++ -- ** Results and Errors+ -- $results+ Trifecta.Delta.Delta (..),+ Result (..),+ eitherResult,+ result,+ success,+ failure,++ -- * Input+ -- $input+ fromValue,+ fromPairs,+ (.=),++ -- * Version+ version,++ -- * Syntax+ Delim,+ Syntax,+ delimPragma,+ delimInline,+ delimComment,+ delimBlock,+ defaultSyntax,+ alternateSyntax,++ -- ** Pragmas+ -- $pragmas++ -- ** Expressions+ -- $expressions++ -- ** Variables+ -- $variables++ -- ** Conditionals+ -- $conditionals++ -- ** Case Analysis+ -- $case++ -- ** Loops+ -- $loops++ -- ** Includes+ -- $includes++ -- ** Filters+ -- $filters++ -- ** Raw+ -- $raw++ -- ** Comments+ -- $comments++ -- ** Let Expressions+ -- $let+ )+where++import qualified Control.Monad as Monad+import Data.Aeson ((.=))+import Data.Aeson.Types (Object)+import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import qualified Data.Foldable as Foldable+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as Text.Lazy+import qualified Data.Text.Lazy.Builder as Text.Builder+import Data.Text.Prettyprint.Doc (Pretty (..))+import Data.Version (Version)+import qualified Paths_ede as Paths+import qualified System.Directory as Directory+import qualified System.FilePath as FilePath+import qualified Text.EDE.Internal.Eval as Eval+import qualified Text.EDE.Internal.Parser as Parser+import Text.EDE.Internal.Quoting (Term)+import Text.EDE.Internal.Syntax+import Text.EDE.Internal.Types+import qualified Text.Trifecta.Delta as Trifecta.Delta++-- | ED-E Version.+version :: Version+version = Paths.version++-- | Parse Lazy 'Text.Lazy.Text' into a compiled 'Template'.+--+-- Because this function is pure and does not resolve @include@s,+-- encountering an @include@ expression during parsing will result in an 'Error'.+--+-- See 'parseFile' or 'parseWith' for mechanisms to deal with @include@+-- dependencies.+parse ::+ -- | Strict 'ByteString' template definition.+ ByteString ->+ Result Template+parse = Monad.join . parseWith defaultSyntax (includeMap mempty) "Text.EDE.parse"++-- | Parse 'Text' into a compiled 'Template'.+--+-- This function handles all @include@ expressions as 'FilePath's and performs+-- recursive loading/parsing.+parseIO ::+ -- | Parent directory for relatively pathed includes.+ FilePath ->+ -- | Strict 'ByteString' template definition.+ ByteString ->+ IO (Result Template)+parseIO p = parseWith defaultSyntax (includeFile p) "Text.EDE.parse"++-- | Load and parse a 'Template' from a file.+--+-- This function handles all @include@ expressions as 'FilePath's and performs+-- recursive loading/parsing, with pathing of @include@s relatively to the+-- target (unless absolute paths are used).+parseFile ::+ -- | Path to the template to load and parse.+ FilePath ->+ IO (Result Template)+parseFile = parseFileWith defaultSyntax++-- | /See:/ 'parseFile'.+parseFileWith ::+ -- | Delimiters and parsing options.+ Syntax ->+ -- | Path to the template to load and parse.+ FilePath ->+ IO (Result Template)+parseFileWith s p =+ loadFile p+ >>= result+ failure+ (parseWith s (includeFile (FilePath.takeDirectory p)) (Text.pack p))++-- | Parse a 'Template' from a Strict 'ByteString' using a custom function for+-- resolving @include@ expressions.+--+-- Two custom @include@ resolvers are supplied:+--+-- * 'includeMap'+--+-- * 'includeFile'+--+-- 'parseFile' for example, is defined as: 'parseWith' 'includeFile'.+parseWith ::+ Monad m =>+ -- | Delimiters and parsing options.+ Syntax ->+ -- | Function to resolve includes.+ Resolver m ->+ -- | Strict 'Text' name.+ Text ->+ -- | Strict 'ByteString' template definition.+ ByteString ->+ m (Result Template)+parseWith config f name =+ result failure resolve+ . Parser.runParser config name+ where+ resolve (u, is) =+ Foldable.foldrM include (Success (HashMap.singleton name u)) (HashMap.toList is)+ >>= result failure (success . Template name u)++ -- Presuming self is always in self's includes, see singleton above.+ -- FIXME: utilise the list of deltas for failures+ include (_, _) (Failure err) = failure err+ include (key, delta :| _) (Success ss) =+ f config key delta+ >>= result failure (success . mappend ss . _tmplIncl)++-- | 'HashMap' resolver for @include@ expressions.+--+-- The 'identifier' component of the @include@ expression is treated as a lookup+-- key into the supplied 'HashMap'.+-- If the 'identifier' doesn't exist in the 'HashMap', an 'Error' is returned.+includeMap ::+ Monad m =>+ -- | A 'HashMap' of named 'Template's.+ HashMap Id Template ->+ -- | Resolver for 'parseWith'.+ Resolver m+includeMap templates _config key _delta+ | Just val <- HashMap.lookup key templates = success val+ | otherwise = failure ("unable to resolve " <> pretty (Text.unpack key))++-- FIXME: utilise deltas in error messages++-- | 'FilePath' resolver for @include@ expressions.+--+-- The 'identifier' component of the @include@ expression is treated as a relative+-- 'FilePath' and the template is loaded and parsed using 'parseFile'.+-- If the 'identifier' doesn't exist as a valid 'FilePath', an 'Error' is returned.+includeFile ::+ -- | Parent directory for relatively pathed includes.+ FilePath ->+ Resolver IO+includeFile path config key _delta =+ loadFile file >>= result failure (parseWith config include key)+ where+ include :: Resolver IO+ include = includeFile (FilePath.takeDirectory file)++ file+ | Text.null key = Text.unpack key+ | otherwise = FilePath.combine path (Text.unpack key)++loadFile :: FilePath -> IO (Result ByteString)+loadFile path = do+ exists <- Directory.doesFileExist path++ if not exists+ then failure ("file " <> pretty path <> " doesn't exist.")+ else ByteString.readFile path >>= success++-- | Render an 'Object' using the supplied 'Template'.+render ::+ -- | Parsed 'Template' to render.+ Template ->+ -- | Bindings to make available in the environment.+ Object ->+ Result Text.Lazy.Text+render = renderWith mempty++-- | Render an 'Object' using the supplied 'Template'.+renderWith ::+ -- | Filters to make available in the environment.+ HashMap Id Term ->+ -- | Parsed 'Template' to render.+ Template ->+ -- | Bindings to make available in the environment.+ Object ->+ Result Text.Lazy.Text+renderWith fs (Template _ u ts) =+ fmap Text.Builder.toLazyText . Eval.render ts fs u++-- | /See:/ 'parse'+eitherParse :: ByteString -> Either String Template+eitherParse = eitherResult . parse++-- | /See:/ 'parseFile'+eitherParseFile :: FilePath -> IO (Either String Template)+eitherParseFile = fmap eitherResult . parseFile++-- | /See:/ 'parseWith'+eitherParseWith ::+ (Functor m, Monad m) =>+ Syntax ->+ Resolver m ->+ Text ->+ ByteString ->+ m (Either String Template)+eitherParseWith o f n = fmap eitherResult . parseWith o f n++-- | /See:/ 'render'+eitherRender ::+ Template ->+ Object ->+ Either String Text.Lazy.Text+eitherRender t = eitherResult . render t++-- | /See:/ 'renderWith'+eitherRenderWith ::+ HashMap Id Term ->+ Template ->+ Object ->+ Either String Text.Lazy.Text+eitherRenderWith fs t = eitherResult . renderWith fs t++-- $usage+--+-- A simple example of parsing and rendering 'Text' containing a basic conditional+-- expression and variable interpolation follows.+--+-- First the 'Template' is defined and parsed in the 'Result' monad:+--+-- >>> tmpl <- parse "{% if var %}\nHello, {{ var }}!\n{% else %}\nnegative!\n{% endif %}\n" :: Result Template+--+-- Then an 'Object' is defined containing the environment which will be+-- available to the 'Template' during rendering:+--+-- >>> let env = fromPairs [ "var" .= "World" ] :: Object+--+-- Note: the 'fromPairs' function above is a wrapper over Aeson's 'object'+-- which removes the outer 'Object' 'Value' constructor, exposing the underlying 'HashMap'.+--+-- Then, the 'Template' is rendered using the 'Object' environment:+--+-- >>> render tmpl env :: Result Text+-- > Success "Hello, World!"+--+-- In this manner, 'Template's can be pre-compiled to the internal AST and+-- the cost of parsing can be amortised if the same 'Template' is rendered multiple times.+--+-- Another example, this time rendering a 'Template' from a file:+--+-- > import qualified Data.Text.Lazy as Text.Lazy+-- > import qualified Text.EDE as EDE+-- >+-- > main :: IO ()+-- > main = do+-- > r <- eitherParseFile "template.ede"+-- > either error print $ r >>= (`eitherRender` env)+-- > where+-- > env = fromPairs+-- > [ "text" .= "Some Text."+-- > , "int" .= 1+-- > , "list" .= [5..10]+-- > ]+--+-- Please see the syntax section for more information about available+-- statements and expressions.++-- $parsing_and_rendering+--+-- Parsing and rendering require two separate steps intentionally so that the+-- more expensive (and potentially impure) action of parsing and resolving+-- @include@s can be embedded and re-used in a pure fashion.+--+-- * Parsing tokenises the input and converts it to an internal AST representation,+-- resolving @include@s using a custom function. The result is a compiled template+-- which can be cached for future use.+--+-- * Rendering takes a 'HashMap' of custom 'Fun's (functions available in the+-- template context), an 'Object' as the binding environment, and a parsed+-- 'Template' to subsitute the values into.+-- The result is a Lazy 'Text.Lazy.Text' value containing the rendered output.++-- $resolvers+--+-- The 'Resolver' used to resolve @include@ expressions determines the purity+-- of 'Template' parsing.+--+-- For example, using the 'includeFile' 'Resolver' means parsing is restricted+-- to 'IO', while pre-caching a 'HashMap' of 'Template's and supplying them to+-- 'parseWith' using 'includeMap' offers a pure variant for @include@ resolution.++-- $results+--+-- The 'Result' of a 'parse' or 'render' steps can be inspected or analysed using+-- 'result' as follows:+--+-- >>> result failure success $ render tmpl env+--+-- If you're only interested in dealing with errors as strings, and the positional+-- information contained in 'Meta' is not of use you can use the convenience functions+-- 'eitherParse', 'eitherRender', or convert a 'Result' to 'Either' using 'eitherResult'.+--+-- >>> either failure success $ eitherParse tmpl++-- $input+--+-- 'fromPairs' (or 'fromValue') is a wrapper around Aeson's 'object' function which+-- safely strips the outer 'Value' constructor, providing the correct type+-- signature for input into 'render'.+--+-- It is used in combination with the re-exported '.=' as follows:+--+-- >>> render (fromPairs [ "foo" .= "value", "bar" .= 1 ]) :: Template -> Result Text++-- #syntax#+--++-- $pragmas+--+-- Syntax can be modified either via the arguments to 'parseWith' or alternatively+-- by specifying the delimiters via an @EDE_SYNTAX@ pragma.+--+-- /Note:/ The pragmas must start on line1. Subsequently encountered+-- pragmas are parsed as textual template contents.+--+-- For example:+--+-- > {! EDE_SYNTAX pragma=("{*", "*}") inline=("#@", "@#") comment=("<#", "#>") block=("$$", "$$") !}+-- > {* EDE_SYNTAX block=("#[", "]#") *}+-- > ...+--+-- Would result in the following syntax:+--+-- * Pragmas: @{* ... *}@+--+-- * Inline: @\#\@ ... \@\#@+--+-- * Comment: @\<\# ... \#>@+--+-- * Block: @\#[ ... ]\#@+--+-- /Note:/ @EDE_SYNTAX@ pragmas only take effect for the current template, not+-- child includes. If you want to override the syntax for all templates use 'parseWith'+-- and custom 'Syntax' settings.++-- $expressions+--+-- Expressions behave as any simplistic programming language with a variety of+-- prefix, infix, and postifx operators available. (/See:/ "Text.EDE.Filters")+--+-- A rough overview of the expression grammar:+--+-- > expression ::= literal | identifier | '|' filter+-- > filter ::= identifier+-- > identifier ::= [a-zA-Z_]{1}[0-9A-Za-z_']*+-- > object ::= '{' pairs '}'+-- > pairs ::= string ':' literal | string ':' literal ',' pairs+-- > array ::= '[' elements ']'+-- > elements ::= literal | literal ',' elements+-- > literal ::= object | array | boolean | number | string+-- > boolean ::= true | false+-- > number ::= integer | double+-- > string ::= "char+|escape"++--+-- /Note:/+--++-- * Identifiers are named similarly to Haskell's rules.++--++-- * Booleans are lowered cased.++--++-- * The string quoting and escaping follows Haskell's rules.++--++-- * The Numeric format shares the same characteristics as the <http://json.org/ JSON specification.>++-- $variables+--+-- Variables are substituted directly for their renderable representation.+-- An error is raised if the varaible being substituted is not a literal type+-- (ie. an 'Array' or 'Object') or doesn't exist in the supplied environment.+--+-- > {{ var }}+--+-- Nested variable access is also supported for variables which resolve to an 'Object'.+-- Dot delimiters are used to chain access through multiple nested 'Object's.+-- The right-most accessor must resolve to a renderable type as with the previous+-- non-nested variable access.+--+-- > {{ nested.var.access }}++-- $conditionals+--+-- A conditional is introduced and completed with the section syntax:+--+-- > {% if <expr1> %}+-- > ... consequent expressions+-- > {% elif <expr2> %}+-- > ... consequent expressions+-- > {% elif <expr3> %}+-- > ... consequent expressions+-- > {% else %}+-- > ... alternate expressions+-- > {% endif %}+--+-- The boolean result of the @expr@ determines the branch that is rendered by+-- the template with multiple (or none) elif branches supported, and the+-- else branch being optional.+--+-- In the case of a literal it conforms directly to the supported boolean or relation logical+-- operators from Haskell.+-- If a variable is singularly used its existence determines the result of the predicate;+-- the exception to this rule is boolean values which will be substituted into the+-- expression if they exist in the supplied environment.+--+-- The following logical expressions are supported as predicates in conditional statements+-- with parameters type checked and an error raised if the left and right+-- hand sides are not type equivalent.+--+-- * @And@: '&&'+--+-- * @Or@: '||'+--+-- * @Equal@: '=='+--+-- * @Not Equal@: @!=@ (/See:/ '/=')+--+-- * @Greater@: '>'+--+-- * @Greater Or Equal@: '>='+--+-- * @Less@: '<'+--+-- * @Less Or Equal@: '<='+--+-- * @Negation@: @!@ (/See:/ 'not')+--+-- /See:/ "Text.EDE.Filters"++-- $case+--+-- To pattern match a literal or variable, you can use the @case@ statement:+--+-- > {% case var %}+-- > {% when "a" %}+-- > .. matched expressions+-- > {% when "b" %}+-- > .. matched expressions+-- > {% else %}+-- > .. alternate expressions+-- > {% endcase %}+--+-- Patterns take the form of @variables@, @literals@, or the wild-card+-- '@_@' pattern (which matches anything).++-- $loops+--+-- Iterating over an 'Array' or 'Object' can be acheived using the 'for ... in' section syntax.+-- Attempting to iterate over any other type will raise an error.+--+-- Example:+--+-- > {% for var in list %}+-- > ... iteration expression+-- > {% else %}+-- > ... alternate expression+-- > {% endfor %}+--+-- The iteration branch is rendering per item with the else branch being (which is optional)+-- being rendered if the @{{ list }}@ variable is empty.+--+-- When iterating over an 'Object', a stable sort using key equivalence is applied, 'Array's+-- are unmodified.+--+-- The resulting binding within the iteration expression (in this case, @{{ var }}@) is+-- an 'Object' containing the following keys:+--+-- * @key :: Text@: They key if the loop target is an 'Object'+--+-- * @value :: a@: The value of the loop target+--+-- * @loop :: Object@: Loop metadata.+--+-- * @length :: Int@: Length of the loop+--+-- * @index :: Int@: Index of the iteration+--+-- * @index0 :: Int@: Zero based index of the iteration+--+-- * @remainder :: Int@: Remaining number of iterations+--+-- * @remainder0 :: Int@: Zero based remaining number of iterations+--+-- * @first :: Bool@: Is this the first iteration?+--+-- * @last :: Bool@: Is this the last iteration?+--+-- * @odd :: Bool@: Is this an odd iteration?+--+-- * @even :: Bool@: Is this an even iteration?+--+-- For example:+--+-- > {% for item in items %}+-- > {{ item.index }}:{{ item.value }}+-- > {% if !item.last %}+-- >+-- > {% endif %}+-- > {% endfor %}+--+-- Will render each item with its (1-based) loop index as a prefix, separated+-- by a blank newline, without a trailing at the end of the document.+--+-- Valid loop targets are 'Object's, 'Array's, and 'String's, with only 'Object's+-- having an available @{{ <var>.key }}@ in scope.++-- $includes+--+-- Includes are a way to reduce the amount of noise in large templates.+-- They can be used to abstract out common snippets and idioms into partials.+--+-- If 'parseFile' or the 'includeFile' resolver is used, templates will be loaded+-- using 'FilePath's. (This is the default.)+--+-- For example:+--+-- > {% include "/var/tmp/partial.ede" %}+--+-- Loads @partial.ede@ from the file system.+--+-- The current environment is made directly available to the included template.+-- Additional bindings can be created (/See:/ @let@) which will be additionally+-- available only within the include under a specific identifier:+--+-- > {% include "/var/tmp/partial.ede" with some_number = 123 %}+--+-- Includes can also be resolved using pure 'Resolver's such as 'includeMap',+-- which will treat the @include@ expression's identifier as a 'HashMap' key:+--+-- > {% include "arbitrary_key" %}+--+-- Uses 'Map.lookup' to find @arbitrary_key@ in the 'HashMap' supplied to 'includeMap'.++-- $filters+--+-- Filters are typed functions which can be applied to variables and literals.+-- An example of rendering a lower cased boolean would be:+--+-- > {{ true | show | lower }}+--+-- The input is on the LHS and chained filters (delimited by the pipe operator @|@)+-- are on the RHS, with filters being applied postfix, left associatively.+--+-- /See:/ "Text.EDE.Filters"++-- $raw+--+-- You can disable template processing for blocks of text using the @raw@ section:+--+-- > {% raw %}+-- > Some {{{ handlebars }}} or {{ mustache }} or {{ jinja2 }} output tags etc.+-- > {% endraw %}+--+-- This can be used to avoid parsing expressions which would otherwise be+-- considered valid @ED-E@ syntax.++-- $comments+--+-- Comments are ignored by the parser and omitted from the rendered output.+--+-- > {# singleline comment #}+--+-- > {#+-- > multiline+-- > comment+-- > #}++-- $let+--+-- You can also bind an identifier to values which will be available within+-- the following expression scope.+--+-- For example:+--+-- > {% let var = false %}+-- > ...+-- > {{ var }}+-- > ...+-- > {% endlet %}
+ lib/Text/EDE/Filters.hs view
@@ -0,0 +1,220 @@+-- |+-- Module : Text.EDE.Filters+-- 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)+--+-- The means to construct your own filters.+module Text.EDE.Filters+ ( -- * Prelude+ -- $prelude++ -- ** Boolean+ -- $boolean++ -- ** Equality+ -- $equality++ -- ** Relational+ -- $relational++ -- ** Numeric+ -- $numeric++ -- ** Fractional+ -- $fractional++ -- ** Textual+ -- $textual++ -- ** Collection+ -- $collection++ -- ** Polymorphic+ -- $polymorphic++ -- * Constructing filters+ Term (..),++ -- ** Classes+ Quote (..),+ Unquote (..),++ -- ** Restricted quoters+ (@:),+ qapply,+ qpoly2,+ qnum1,+ qnum2,+ qcol1,++ -- ** Errors+ typeErr,+ argumentErr,+ )+where++import Text.EDE.Internal.Filters+import Text.EDE.Internal.Quoting++-- $prelude+--+-- The default filters available to a template are documented by the subsequent categories.+--+-- These filters cannot be overriden and attempting to supply your own filters to+-- 'Text.EDE.renderWith' will cause the similarly named filters to disappear when+-- they are merged with the prelude during evaluation. (/See:/ 'Data.HashMap.Strict.union')++-- $boolean+--+-- [@! :: Bool -> Bool@]+-- /See:/ 'not'+--+-- [@'&&' :: Bool -> Bool -> Bool@]+--+-- [@'||' :: Bool -> Bool -> Bool@]++-- $equality+--+-- [@'==' :: a -> a -> Bool@]+--+-- [@!= :: a -> a -> Bool@]+-- /See/: '/='++-- $relational+--+-- [@'>' :: a -> a -> Bool@]+--+-- [@'>=' :: a -> a -> Bool@]+--+-- [@'<=' :: a -> a -> Bool@]+--+-- [@'<' :: a -> a -> Bool@]++-- $numeric+--+-- [@'+' :: Scientific -> Scientific -> Scientific@]+--+-- [@'-' :: Scientific -> Scientific -> Scientific@]+--+-- [@'*' :: Scientific -> Scientific -> Scientific@]+--+-- [@'abs' :: Scientific -> Scientific@]+--+-- [@'negate' :: Scientific -> Scientific@]+--+-- [@'signum' :: Scientific -> Scientific@]++-- $fractional+--+-- [@'ceiling' :: Scientific -> Scientific@]+--+-- [@'floor' :: Scientific -> Scientific@]+--+-- [@'round' :: Scientific -> Scientific@]+--+-- [@'truncate' :: Scientific -> Scientific@]++-- $textual+--+-- [@dropLower :: Text -> Text@]+-- Drop preceding lowercase characters.+--+-- [@'dropUpper' :: Text -> Text@]+-- Drop preceding uppercase characters.+--+-- [@'Data.Text.Manipulate.indentLines' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.prependLines' :: Text -> Text@]+--+-- [@'Data.Text.justifyLeft' :: Text -> Text@]+-- Using whitespace as fill character.+--+-- [@'Data.Text.justifyRight' :: Text -> Text@]+-- Using whitespace as fill character.+--+-- [@'Data.Text.center' :: Text -> Text@]+-- Using whitespace as fill character.+--+-- [@'Data.Text.replace' :: Text -> Text@]+--+-- [@remove@ @:: Text -> Text@]+-- Shortcut for: @replace(pattern, "")@+--+-- [@'Data.Text.Manipulate.splitWords' :: Text -> Text@]+--+-- [@'Data.Text.strip' :: Text -> Text@]+--+-- [@'Data.Text.stripPrefix' :: Text -> Text@]+--+-- [@'Data.Text.stripSuffix' :: Text -> Text@]+--+-- [@'Data.Text.stripStart' :: Text -> Text@]+--+-- [@'Data.Text.stripEnd' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.takeWord' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.dropWord' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.lowerHead' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.upperHead' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.toCamel' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.toEllipsis' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.toEllipsisWith' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.toPascal' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.toSnake' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.toSpinal' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.toTitle' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.toTrain' :: Text -> Text@]+--+-- [@'Data.Text.toLower' :: Text -> Text@]+--+-- [@'Data.Text.toUpper' :: Text -> Text@]+--+-- [@'Data.Text.Manipulate.toOrdinal' :: Scientific -> Text@]++-- $collection+--+-- [@length :: Collection -> Scientific@]+-- /See/: Text.'Data.Text.length', Vector.'Data.Vector.length', HashMap.'Data.HashMap.Strict.size'+--+-- [@empty :: Collection -> Bool@]+-- /See/: Text.'Data.Text.null', Vector.'Data.Vector.null', HashMap.'Data.HashMap.Strict.null'+--+-- [@reverse :: Collection -> Scientific@]+-- /See/: Text.'Data.Text.reverse', Vector.'Data.Vector.reverse'+--+-- [@head :: Collection -> Scientific@]+-- /See/: Text.'Data.Text.head', Vector.'Data.Vector.head'+--+-- [@last :: Collection -> Scientific@]+-- /See/: Text.'Data.Text.last', Vector.'Data.Vector.last'+--+-- [@tail :: Collection -> Scientific@]+-- /See/: Text.'Data.Text.tail', Vector.'Data.Vector.tail'+--+-- [@init@ @:: Collection -> Scientific@]+-- /See/: Text.'Data.Text.init', Vector.'Data.Vector.init'+--+-- [@'Data.HashMap.Strict.keys' :: Collection -> Scientific@]+--+-- [@'Data.HashMap.Strict.elems' :: Collection -> Scientific@]++-- $polymorphic+--+-- [@'show' :: a -> Text@]
+ lib/Text/EDE/Internal/AST.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++-- |+-- Module : Text.EDE.Internal.AST+-- 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!+--+-- AST smart constructors.+module Text.EDE.Internal.AST where++import qualified Control.Comonad as Comonad+import Control.Comonad.Cofree (Cofree ((:<)))+import Data.Aeson.Types (Value (..))+import qualified Data.Foldable as Foldable+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Maybe as Maybe+import Text.EDE.Internal.Types++newtype Fix f = Fix (f (Fix f))++cofreeFix :: Functor f => a -> Fix f -> Cofree f a+cofreeFix x = go+ where+ go (Fix f) = x :< fmap go f+{-# INLINEABLE cofreeFix #-}++var :: Id -> Var+var = Var . (:| [])+{-# INLINEABLE var #-}++eapp :: a -> [Exp a] -> Exp a+eapp x [] = cofreeFix x blank+eapp _ [e] = e+eapp _ (e : es) = Foldable.foldl' (\x y -> Comonad.extract x :< EApp x y) e es+{-# INLINEABLE eapp #-}++efun :: Id -> Exp a -> Exp a+efun i e = let x = Comonad.extract e in x :< EApp (x :< EFun i) e+{-# INLINEABLE efun #-}++efilter :: Exp a -> (Id, [Exp a]) -> Exp a+efilter e (i, ps) = let x = Comonad.extract e in eapp x ((x :< EFun i) : e : ps)+{-# INLINEABLE efilter #-}++elet :: Maybe (Id, Exp a) -> Exp a -> Exp a+elet m e = maybe e (\(i, b) -> Comonad.extract b :< ELet i b e) m+{-# INLINEABLE elet #-}++ecase ::+ Exp a ->+ [Alt (Exp a)] ->+ Maybe (Exp a) ->+ Exp a+ecase p ws f = Comonad.extract p :< ECase p (ws ++ maybe [] ((: []) . wild) f)+{-# INLINEABLE ecase #-}++eif ::+ (Exp a, Exp a) ->+ [(Exp a, Exp a)] ->+ Maybe (Exp a) ->+ Exp a+eif t ts f =+ Foldable.foldr'+ c+ (Maybe.fromMaybe (Comonad.extract (fst t) `cofreeFix` blank) f)+ (t : ts)+ where+ c (p, w) e = Comonad.extract p :< ECase p [true w, false e]+{-# INLINEABLE eif #-}++eempty :: Exp a -> Exp a -> Maybe (Exp a) -> Exp a+eempty v e = maybe e (eif (efun "!" (efun "empty" v), e) [] . Just)+{-# INLINEABLE eempty #-}++true, false, wild :: Exp a -> Alt (Exp a)+true = (PLit (Bool True),)+false = (PLit (Bool False),)+wild = (PWild,)+{-# INLINEABLE true #-}+{-# INLINEABLE false #-}+{-# INLINEABLE wild #-}++blank :: Fix ExpF+blank = Fix (ELit (String mempty))+{-# INLINEABLE blank #-}
+ lib/Text/EDE/Internal/Eval.hs view
@@ -0,0 +1,240 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++-- |+-- Module : Text.EDE.Internal.Eval+-- 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.Eval where++import Control.Comonad.Cofree (Cofree ((:<)))+import qualified Control.Monad as Monad+import Control.Monad.Reader (ReaderT)+import qualified Control.Monad.Reader as Reader+import Control.Monad.Trans (lift)+import Data.Aeson ((.=))+import qualified Data.Aeson as Aeson+import Data.Aeson.Types (Object, Value (..))+import qualified Data.Foldable as Foldable+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NonEmpty+import Data.Scientific (isFloating)+import qualified Data.Text as Text+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as Text.Builder+import Data.Text.Lazy.Builder.Scientific (FPFormat (Fixed), formatScientificBuilder)+import Data.Text.Manipulate (toOrdinal)+import Data.Text.Prettyprint.Doc ((<+>))+import qualified Data.Text.Prettyprint.Doc as PP+import Text.EDE.Internal.Filters (stdlib)+import Text.EDE.Internal.Quoting+import Text.EDE.Internal.Types+import Text.Trifecta.Delta (Delta)+import qualified Text.Trifecta.Delta as Trifecta.Delta++data Env = Env+ { _templates :: HashMap Id (Exp Delta),+ _quoted :: HashMap Id Term,+ _values :: HashMap Id Value+ }++type Context = ReaderT Env Result++render ::+ HashMap Id (Exp Delta) ->+ HashMap Id Term ->+ Exp Delta ->+ HashMap Id Value ->+ Result Builder+render ts fs e o =+ Reader.runReaderT (eval e >>= nf) (Env ts (stdlib <> fs) o)+ where+ nf (TVal v) = build (Trifecta.Delta.delta e) v+ nf _ =+ lift $+ Failure+ "unable to evaluate partially applied template to normal form."++eval :: Exp Delta -> Context Term+eval (_ :< ELit l) = pure (qprim l)+eval (d :< EVar v) = quote (Text.pack (show v)) 0 <$> variable d v+eval (d :< EFun i) = do+ q <- HashMap.lookup i <$> Reader.asks _quoted+ maybe+ (throwError d $ "filter" <+> bold (pp i) <+> "doesn't exist.")+ pure+ q+eval (_ :< EApp (_ :< EFun "defined") e) = predicate e+eval (d :< EApp a b) = do+ x <- eval a+ y <- eval b+ binding d x y+eval (_ :< ELet k rhs bdy) = do+ q <- eval rhs+ v <- lift (unquote k 0 q)+ bind (HashMap.insert k v) (eval bdy)++-- FIXME: We have to recompute c everytime due to the predicate+eval (d :< ECase p ws) = go ws+ where+ go [] = pure (qprim (String mempty))+ go ((a, e) : as) =+ case a of+ PWild -> eval e+ PVar v -> eval (d :< EVar v) >>= cond e as+ PLit l -> eval (d :< ELit l) >>= cond e as++ cond e as y@(TVal Bool {}) = do+ x <- predicate p+ if x `eq` y+ then eval e+ else go as+ cond e as y@TVal {} = do+ x <- eval p+ if x `eq` y+ then eval e+ else go as+ cond _ as _ = go as++ eq (TVal a) (TVal b) = a == b+ eq _ _ = False+eval (_ :< ELoop i v bdy) = eval v >>= lift . unquote i 0 >>= loop+ where+ d = Trifecta.Delta.delta bdy++ loop :: Collection -> Context Term+ loop (Col l xs) = snd <$> Foldable.foldlM iter (1, qprim (String mempty)) xs+ where+ iter (n, p) x = do+ shadowed n+ q <- bind (HashMap.insert i (context n x)) (eval bdy)+ r <- binding d p q+ pure (n + 1, r)++ shadowed n = do+ m <- Reader.asks _values+ maybe+ (pure ())+ (shadowedErr n)+ (HashMap.lookup i m)++ shadowedErr n x =+ throwError d $+ "variable"+ <+> bold (pp i)+ <+> "shadows"+ <+> pp x+ <+> "in"+ <+> pp (toOrdinal n)+ <+> "loop iteration."++ context n (k, x) =+ Aeson.object $+ [ "value" .= x,+ "length" .= l,+ "index" .= n,+ "index0" .= (n - 1),+ "remainder" .= (l - n),+ "remainder0" .= (l - n - 1),+ "first" .= (n == 1),+ "last" .= (n == l),+ "odd" .= (n `mod` 2 == 1),+ "even" .= (n `mod` 2 == 0)+ ]+ ++ key k++ key (Just k) = ["key" .= k]+ key Nothing = []+eval (d :< EIncl i) = do+ ts <- Reader.asks _templates+ case HashMap.lookup i ts of+ Just e -> eval e+ Nothing ->+ throwError d $+ "template"+ <+> bold (pp i)+ <+> "is not in scope:"+ <+> PP.brackets (pp (Text.intercalate "," $ HashMap.keys ts))+{-# INLINEABLE eval #-}++bind :: (Object -> Object) -> Context a -> Context a+bind f = Reader.withReaderT (\x -> x {_values = f (_values x)})+{-# INLINEABLE bind #-}++variable :: Delta -> Var -> Context Value+variable d (Var is) =+ Reader.asks _values >>= go (NonEmpty.toList is) [] . Object+ where+ go [] _ v = pure v+ go (k : ks) r v = do+ m <- nest v+ maybe+ (throwError d $ "variable" <+> apretty cur <+> "doesn't exist.")+ (go ks (k : r))+ (HashMap.lookup k m)+ where+ cur = Var (k :| r)++ nest :: Value -> Context Object+ nest (Object o) = pure o+ nest x =+ throwError d $+ "variable"+ <+> apretty cur+ <+> "::"+ <+> pp x+ <+> "doesn't supported nested accessors."+{-# INLINEABLE variable #-}++-- | A variable can be tested for truthiness, but a non-whnf expr cannot.+predicate :: Exp Delta -> Context Term+predicate x =+ Reader.runReaderT (eval x) <$> Reader.ask+ >>= lift . \case+ Success q+ | TVal Bool {} <- q -> Success q+ Success q+ | TVal Null <- q -> Success (qprim False)+ Success _ -> Success (qprim True)+ Failure _+ | _ :< EVar {} <- x -> Success (qprim False)+ Failure e -> Failure e+{-# INLINEABLE predicate #-}++binding :: Delta -> Term -> Term -> Context Term+binding d x y =+ case (x, y) of+ (TVal l, TVal r) -> quote "<>" 0 <$> Monad.liftM2 (<>) (build d l) (build d r)+ _ -> lift (qapply d x y)+{-# INLINEABLE binding #-}++build :: Delta -> Value -> Context Builder+build _ Null = pure mempty+build _ (String t) = pure (Text.Builder.fromText t)+build _ (Bool True) = pure "true"+build _ (Bool False) = pure "false"+build _ (Number n)+ | isFloating n = pure (formatScientificBuilder Fixed Nothing n)+ | otherwise = pure (formatScientificBuilder Fixed (Just 0) n)+build d x =+ throwError d ("unable to render literal" <+> pp x)+{-# INLINEABLE build #-}++-- FIXME: Add delta information to the thrown error document.+throwError :: Delta -> AnsiDoc -> Context a+throwError d doc =+ lift . Failure $ Trifecta.Delta.prettyDelta d <+> red "error:" <+> doc
+ lib/Text/EDE/Internal/Filters.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- |+-- Module : Text.EDE.Internal.Filters+-- 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.Filters where++import qualified Data.Aeson as Aeson+import Data.Aeson.Types (Array, Object, Value (..))+import qualified Data.Char as Char+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Maybe as Maybe+import Data.Scientific (Scientific)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as Text.Lazy+import qualified Data.Text.Lazy.Encoding as Text.Lazy.Encoding+import qualified Data.Text.Manipulate as Text.Manipulate+import Data.Text.Prettyprint.Doc ((<+>))+import qualified Data.Text.Unsafe as Text.Unsafe+import qualified Data.Vector as Vector+import Text.EDE.Internal.Quoting+import Text.EDE.Internal.Types++default (Integer)++stdlib :: HashMap Text Term+stdlib =+ HashMap.fromList+ -- boolean+ [ "!" @: not,+ "&&" @: (&&),+ "||" @: (||),+ -- equality+ "==" `qpoly2` (==),+ "!=" `qpoly2` (/=),+ -- relational+ ">" `qnum2` (>),+ ">=" `qnum2` (>=),+ "<=" `qnum2` (<=),+ "<" `qnum2` (<),+ -- numeric+ "+" `qnum2` (+),+ "-" `qnum2` (-),+ "*" `qnum2` (*),+ "abs" `qnum1` abs,+ "signum" `qnum1` signum,+ "negate" `qnum1` negate,+ -- fractional+ "truncate" `qnum1` (fromIntegral . truncate),+ "round" `qnum1` (fromIntegral . round),+ "ceiling" `qnum1` (fromIntegral . ceiling),+ "floor" `qnum1` (fromIntegral . floor),+ -- text+ "lowerHead" @: Text.Manipulate.lowerHead,+ "upperHead" @: Text.Manipulate.upperHead,+ "toTitle" @: Text.Manipulate.toTitle,+ "toCamel" @: Text.Manipulate.toCamel,+ "toPascal" @: Text.Manipulate.toPascal,+ "toSnake" @: Text.Manipulate.toSnake,+ "toSpinal" @: Text.Manipulate.toSpinal,+ "toTrain" @: Text.Manipulate.toTrain,+ "toUpper" @: Text.toUpper,+ "toLower" @: Text.toLower,+ "toOrdinal" @: (Text.Manipulate.toOrdinal :: Integer -> Text),+ "dropLower" @: Text.dropWhile (not . Char.isUpper),+ "dropUpper" @: Text.dropWhile (not . Char.isLower),+ "takeWord" @: Text.Manipulate.takeWord,+ "dropWord" @: Text.Manipulate.dropWord,+ "splitWords" @: Text.Manipulate.splitWords,+ "strip" @: Text.strip,+ "stripPrefix" @: (\x p -> Maybe.fromMaybe x (p `Text.stripPrefix` x)),+ "stripSuffix" @: (\x s -> Maybe.fromMaybe x (s `Text.stripSuffix` x)),+ "stripStart" @: Text.stripStart,+ "stripEnd" @: Text.stripEnd,+ "replace" @: flip Text.replace,+ "remove" @: (\x r -> Text.replace r "" x),+ "toEllipsis" @: flip Text.Manipulate.toEllipsis,+ "toEllipsisWith" @: (\x n e -> Text.Manipulate.toEllipsisWith n e x),+ "indentLines" @: flip Text.Manipulate.indentLines,+ "prependLines" @: flip Text.Manipulate.prependLines,+ "justifyLeft" @: (\x n -> Text.justifyLeft n ' ' x),+ "justifyRight" @: (\x n -> Text.justifyRight n ' ' x),+ "center" @: (\x n -> Text.center n ' ' x),+ -- sequences+ qcol1 "length" Text.length HashMap.size Vector.length,+ qcol1 "empty" Text.null HashMap.null Vector.null,+ qcol1 "reverse" Text.reverse id Vector.reverse,+ -- lists+ qlist1 "head" headT headV,+ qlist1 "last" lastT lastV,+ qlist1 "tail" tailT tailV,+ qlist1 "init" initT initV,+ "at" @: (\x i -> x Vector.! i :: Value),+ -- object+ "keys" @: (HashMap.keys :: Object -> [Text]),+ "elems" @: (HashMap.elems :: Object -> [Value]),+ -- , "map" @: undefined+ -- , "filter" @: undefined+ -- , "zip" @: undefined+ -- , "join" @: undefined++ -- polymorphic+ "show" @: (Text.Lazy.Encoding.decodeUtf8 . Aeson.encode :: Value -> Text.Lazy.Text),+ "singleton" @: (pure :: Value -> Vector.Vector Value)+ -- FIXME: existence checks currently hardcoded into the evaluator:+ -- "default"+ -- "defined"+ ]++(@:) :: Quote a => Id -> a -> (Id, Term)+k @: q = (k, quote k 0 q)++-- | Quote a binary function which takes the most general binding value.+qpoly2 :: Quote a => Id -> (Value -> Value -> a) -> (Id, Term)+qpoly2 k = (k,) . quote k 0++-- | Quote an unary numeric function.+qnum1 :: Id -> (Scientific -> Scientific) -> (Id, Term)+qnum1 k = (k,) . quote k 0++-- | Quote a binary numeric function.+qnum2 :: Quote a => Id -> (Scientific -> Scientific -> a) -> (Id, Term)+qnum2 k = (k,) . quote k 0++-- | Quote a comprehensive set of unary functions to create a binding+-- that supports list collection types.+qlist1 ::+ (Quote a, Quote b) =>+ Id ->+ (Text -> a) ->+ (Array -> b) ->+ (Id, Term)+qlist1 k f g = (k,) . TLam $ \case+ TVal (String t) -> pure . quote k 0 $ f t+ TVal (Array v) -> pure . quote k 0 $ g v+ x ->+ Failure $+ "when expecting a String or Array, encountered" <+> apretty x++-- | Quote a comprehensive set of unary functions to create a binding+-- that supports all collection types.+qcol1 ::+ (Quote a, Quote b, Quote c) =>+ Id ->+ (Text -> a) ->+ (Object -> b) ->+ (Array -> c) ->+ (Id, Term)+qcol1 k f g h = (k,) . TLam $ \case+ TVal (String t) -> pure . quote k 0 $ f t+ TVal (Object o) -> pure . quote k 0 $ g o+ TVal (Array v) -> pure . quote k 0 $ h v+ x ->+ Failure $+ "when expecting a String, Object, or Array, encountered" <+> apretty x++headT, lastT, tailT, initT :: Text -> Value+headT = text (Text.singleton . Text.Unsafe.unsafeHead)+lastT = text (Text.singleton . Text.last)+tailT = text Text.Unsafe.unsafeTail+initT = text Text.init++headV, lastV, tailV, initV :: Array -> Value+headV = vec Vector.unsafeHead+lastV = vec Vector.unsafeLast+tailV = vec (Array . Vector.unsafeTail)+initV = vec (Array . Vector.unsafeInit)++text :: (Text -> Text) -> Text -> Value+text f = String . safe mempty Text.null f++vec :: (Array -> Value) -> Array -> Value+vec = safe (Array Vector.empty) Vector.null++safe :: b -> (a -> Bool) -> (a -> b) -> a -> b+safe v f g x+ | f x = v+ | otherwise = g x
+ lib/Text/EDE/Internal/Parser.hs view
@@ -0,0 +1,433 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module : Text.EDE.Internal.Parser+-- 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.Parser where++import Control.Applicative (Alternative ((<|>)))+import qualified Control.Comonad as Comonad+import Control.Comonad.Cofree (Cofree ((:<)))+import Control.Lens ((%=))+import qualified Control.Lens as Lens+import Control.Monad (MonadPlus, void)+import Control.Monad.State.Strict (MonadState, StateT)+import qualified Control.Monad.State.Strict as State+import Control.Monad.Trans (lift)+import Data.Aeson.Types (Array, Object, Value (..))+import qualified Data.Bifunctor as Bifunctor+import Data.ByteString (ByteString)+import qualified Data.Char as Char+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NonEmpty+import Data.Scientific (Scientific)+import qualified Data.Scientific as Scientific+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text.Encoding+import qualified Data.Vector as Vector+import Text.EDE.Internal.AST+import Text.EDE.Internal.Syntax+import Text.EDE.Internal.Types+import qualified Text.Parser.Expression as Expression+import Text.Parser.LookAhead (lookAhead)+import qualified Text.Parser.LookAhead as LookAhead+import Text.Parser.Token.Style (buildSomeSpaceParser)+import Text.Trifecta (DeltaParsing, TokenParsing)+import qualified Text.Trifecta as Trifecta+import Text.Trifecta.Delta (Delta)+import qualified Text.Trifecta.Delta as Trifecta.Delta++data Env = Env+ { _settings :: !Syntax,+ _includes :: HashMap Text (NonEmpty Delta)+ }++$(Lens.makeLenses ''Env)++instance HasSyntax Env where+ syntax = settings++type Parser m =+ ( Monad m,+#if MIN_VERSION_base(4,13,0)+ MonadFail m,+#endif+ MonadState Env m,+ Trifecta.TokenParsing m,+ Trifecta.DeltaParsing m,+ LookAhead.LookAheadParsing m,+ Trifecta.Errable m+ )++newtype EDE a = EDE {runEDE :: Trifecta.Parser a}+ deriving+ ( Functor,+ Applicative,+ Alternative,+ Monad,+#if MIN_VERSION_base(4,13,0)+ MonadFail,+#endif+ MonadPlus,+ Trifecta.Parsing,+ Trifecta.CharParsing,+ Trifecta.DeltaParsing,+ LookAhead.LookAheadParsing,+ Trifecta.Errable+ )++instance TokenParsing EDE where+ nesting (EDE m) =+ EDE $ Trifecta.nesting m+ {-# INLINE nesting #-}++ someSpace =+ EDE $ Trifecta.skipMany (Trifecta.satisfy $ \c -> c /= '\n' && Char.isSpace c)+ {-# INLINE someSpace #-}++ semi =+ EDE Trifecta.semi+ {-# INLINE semi #-}++ highlight h (EDE m) = EDE (Trifecta.highlight h m)+ {-# INLINE highlight #-}++instance Trifecta.Errable (StateT Env EDE) where+ raiseErr = lift . Trifecta.raiseErr++runParser ::+ Syntax ->+ Text ->+ ByteString ->+ Result (Exp Delta, HashMap Text (NonEmpty Delta))+runParser o n = res . Trifecta.parseByteString (runEDE run) pos+ where+ run = State.runStateT (pragma *> document <* Trifecta.eof) (Env o mempty)++ pos = Trifecta.Delta.Directed (Text.Encoding.encodeUtf8 n) 0 0 0 0++ res = \case+ Trifecta.Success x -> Success (Bifunctor.second _includes x)+ Trifecta.Failure e -> Failure (Trifecta._errDoc e)++pragma :: Parser m => m ()+pragma =+ void . Trifecta.many $ do+ !xs <- pragmal *> Trifecta.symbol "EDE_SYNTAX" *> Trifecta.sepBy field spaces <* trimr pragmar++ mapM_ (uncurry Lens.assign) xs+ where+ field =+ (,)+ <$> setter <* Trifecta.symbol "="+ <*> Trifecta.parens delim++ delim =+ (,)+ <$> Trifecta.stringLiteral <* Trifecta.symbol ","+ <*> Trifecta.stringLiteral++ setter =+ pragmak "pragma" *> pure delimPragma+ <|> pragmak "inline" *> pure delimInline+ <|> pragmak "comment" *> pure delimComment+ <|> pragmak "block" *> pure delimBlock++document :: Parser m => m (Exp Delta)+document =+ eapp+ <$> Trifecta.position+ <*> Trifecta.many (statement <|> inline <|> fragment)++inline :: Parser m => m (Exp Delta)+inline = Trifecta.between inlinel inliner term++fragment :: Parser m => m (Exp Delta)+fragment =+ ann (ELit <$> pack (Trifecta.notFollowedBy end0 >> Trifecta.try line0 <|> line1))+ where+ line0 = manyTill1 (Trifecta.noneOf "\n") (Trifecta.try (lookAhead end0) <|> Trifecta.eof)+ line1 = manyEndBy1 Trifecta.anyChar Trifecta.newline++ end0 = void (inlinel <|> blockl <|> Trifecta.try end1)+ end1 = multiLine (pure ()) (manyTill1 Trifecta.anyChar (lookAhead blockr))++statement :: Parser m => m (Exp Delta)+statement =+ Trifecta.choice+ [ ifelif,+ cases,+ loop,+ include,+ binding,+ raw,+ comment+ ]++block :: Parser m => String -> m a -> m a+block k p =+ Trifecta.try (multiLine (keyword k) p)+ <|> singleLine (keyword k) p++multiLine :: Parser m => m b -> m a -> m a+multiLine s =+ Trifecta.between (Trifecta.try (triml blockl *> s)) (trimr blockr)++singleLine :: Parser m => m b -> m a -> m a+singleLine s =+ Trifecta.between (Trifecta.try (blockl *> s)) blockr++ifelif :: Parser m => m (Exp Delta)+ifelif =+ eif+ <$> branch "if"+ <*> Trifecta.many (branch "elif")+ <*> else'+ <* exit "endif"+ where+ branch k = (,) <$> block k term <*> document++cases :: Parser m => m (Exp Delta)+cases =+ ecase+ <$> block "case" term+ <*> Trifecta.many+ ( (,) <$> block "when" pattern+ <*> document+ )+ <*> else'+ <* exit "endcase"++loop :: Parser m => m (Exp Delta)+loop = do+ (i, v) <-+ block+ "for"+ ( (,) <$> identifier+ <*> (keyword "in" *> collection)+ )+ d <- document+ eempty v (Comonad.extract v :< ELoop i v d)+ <$> else'+ <* exit "endfor"++include :: Parser m => m (Exp Delta)+include = block "include" $ do+ d <- Trifecta.position+ k <- Trifecta.stringLiteral+ includes %= HashMap.insertWith (<>) k (d :| [])+ elet <$> scope <*> pure (d :< EIncl k)+ where+ scope =+ Trifecta.optional $+ (,) <$> (keyword "with" *> identifier)+ <*> (Trifecta.symbol "=" *> term)++binding :: Parser m => m (Exp Delta)+binding =+ elet . Just+ <$> block+ "let"+ ( (,) <$> identifier+ <*> (Trifecta.symbol "=" *> term)+ )+ <*> document+ <* exit "endlet"++raw :: Parser m => m (Exp Delta)+raw = ann (ELit <$> body)+ where+ body = start *> pack (Trifecta.manyTill Trifecta.anyChar (lookAhead end)) <* end+ start = block "raw" (pure ())+ end = exit "endraw"++-- FIXME: this is due to the whitespace sensitive nature of the parser making+-- it difficult to do what most applicative parsers do by skipping comments+-- as part of the whitespace.+comment :: Parser m => m (Exp Delta)+comment = ann (ELit <$> pure (String mempty) <* (Trifecta.try (triml (trimr go)) <|> go))+ where+ go =+ (commentStyle <$> commentl <*> commentr)+ >>= buildSomeSpaceParser (fail "whitespace significant")++else' :: Parser m => m (Maybe (Exp Delta))+else' = Trifecta.optional (block "else" (pure ()) *> document)++exit :: Parser m => String -> m ()+exit k = block k (pure ())++pattern :: Parser m => m Pat+pattern =+ PWild <$ Trifecta.char '_'+ <|> PVar <$> variable+ <|> PLit <$> literal++term :: Parser m => m (Exp Delta)+term =+ chainl1' term0 (Trifecta.try filter') (Trifecta.symbol "|" *> pure efilter)+ <|> term0++term0 :: Parser m => m (Exp Delta)+term0 = Expression.buildExpressionParser table expr+ where+ table =+ [ [prefix "!"],+ [infix' "*", infix' "/"],+ [infix' "-", infix' "+"],+ [infix' "==", infix' "!=", infix' ">", infix' ">=", infix' "<", infix' "<="],+ [infix' "&&"],+ [infix' "||"]+ ]++ prefix n = Expression.Prefix (efun <$ operator n <*> pure n)++ infix' n =+ Expression.Infix+ ( do+ d <- operator n+ pure $ \l r ->+ d :< EApp (efun n l) r+ )+ Expression.AssocLeft++ expr =+ Trifecta.parens term+ <|> ann (EVar <$> variable)+ <|> ann (ELit <$> literal)++filter' :: Parser m => m (Id, [Exp Delta])+filter' =+ (,)+ <$> identifier+ <*> (Trifecta.parens (Trifecta.commaSep1 term) <|> pure [])++collection :: Parser m => m (Exp Delta)+collection = ann (EVar <$> variable <|> ELit <$> col)+ where+ col =+ Object <$> object+ <|> Array <$> array+ <|> String <$> Trifecta.stringLiteral++literal :: Parser m => m Value+literal =+ Bool <$> bool+ <|> Number <$> number+ <|> String <$> Trifecta.stringLiteral+ <|> Object <$> object+ <|> Array <$> array++number :: Parser m => m Scientific+number =+ either fromIntegral Scientific.fromFloatDigits+ <$> Trifecta.integerOrDouble++bool :: Parser m => m Bool+bool =+ Trifecta.symbol "true" *> pure True+ <|> Trifecta.symbol "false" *> pure False++object :: Parser m => m Object+object = HashMap.fromList <$> Trifecta.braces (Trifecta.commaSep pair)+ where+ pair =+ (,)+ <$> (Trifecta.stringLiteral <* Trifecta.spaces)+ <*> (Trifecta.char ':' *> Trifecta.spaces *> literal)++array :: Parser m => m Array+array = Vector.fromList <$> Trifecta.brackets (Trifecta.commaSep literal)++operator :: Parser m => Text -> m Delta+operator n = Trifecta.position <* Trifecta.reserveText operatorStyle n++keyword :: Parser m => String -> m Delta+keyword k = Trifecta.position <* Trifecta.try (Trifecta.reserve keywordStyle k)++variable :: (Monad m, TokenParsing m) => m Var+variable =+ Var <$> (NonEmpty.fromList <$> Trifecta.sepBy1 identifier (Trifecta.char '.'))++identifier :: (Monad m, TokenParsing m) => m Id+identifier = Trifecta.ident variableStyle++spaces :: (Monad m, TokenParsing m) => m ()+spaces = Trifecta.skipMany (Trifecta.oneOf "\t ")++manyTill1 :: Alternative m => m a -> m b -> m [a]+manyTill1 p end = (:) <$> p <*> Trifecta.manyTill p end++manyEndBy1 :: Alternative m => m a -> m a -> m [a]+manyEndBy1 p end = go+ where+ go = (: []) <$> end <|> (:) <$> p <*> go++chainl1' :: Alternative m => m a -> m b -> m (a -> b -> a) -> m a+chainl1' l r op = scan+ where+ scan = flip id <$> l <*> rst+ rst = (\f y g x -> g (f x y)) <$> op <*> r <*> rst <|> pure id++ann :: (DeltaParsing m, Functor f) => m (f (Fix f)) -> m (Cofree f Delta)+ann p = cofreeFix <$> Trifecta.position <*> (Fix <$> p)++pack :: Functor f => f String -> f Value+pack = fmap (String . Text.pack)++triml :: Parser m => m a -> m a+triml p = do+ c <- Trifecta.Delta.column <$> Trifecta.position+ if c == 0+ then Trifecta.spaces *> p+ else fail "left whitespace removal failed"++trimr :: Parser m => m a -> m a+trimr p = p <* Trifecta.spaces <* Trifecta.newline++pragmak :: Parser m => String -> m ()+pragmak = Trifecta.reserve pragmaStyle++pragmal, pragmar :: Parser m => m String+pragmal = left delimPragma >>= Trifecta.symbol+pragmar = right delimPragma >>= Trifecta.string++commentl, commentr :: MonadState Env m => m String+commentl = left delimComment+commentr = right delimComment++inlinel, inliner :: Parser m => m String+inlinel = left delimInline >>= Trifecta.symbol+inliner = right delimInline >>= Trifecta.string++blockl, blockr :: Parser m => m String+blockl = left delimBlock >>= Trifecta.symbol+blockr = right delimBlock >>= Trifecta.string++left, right :: MonadState s m => Lens.Getter s Delim -> m String+left d = State.gets (fst . Lens.view d)+right d = State.gets (snd . Lens.view d)
+ lib/Text/EDE/Internal/Quoting.hs view
@@ -0,0 +1,226 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++-- |+-- Module : Text.EDE.Internal.Quoting+-- 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.Quoting where++import Control.Applicative ((<|>))+import Control.Monad ((>=>))+import Data.Aeson (FromJSON, ToJSON)+import qualified Data.Aeson as Aeson+import Data.Aeson.Types (Array, Object, Value (..))+import qualified Data.Bifunctor as Bifunctor+import qualified Data.ByteString.Char8 as ByteString.Char8+import qualified Data.HashMap.Strict as HashMap+import Data.List (sortBy)+import Data.Ord (comparing)+import Data.Scientific (Scientific)+import qualified Data.Scientific as Scientific+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text.Encoding+import qualified Data.Text.Lazy as Text.Lazy+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as Text.Builder+import Data.Text.Manipulate (toOrdinal)+import Data.Text.Prettyprint.Doc (Pretty (..), (<+>))+import qualified Data.Text.Prettyprint.Doc as PP+import qualified Data.Vector as Vector+import Text.EDE.Internal.Types+import Text.Trifecta.Delta (Delta)+import qualified Text.Trifecta.Delta as Trifecta.Delta+import qualified Text.Trifecta.Rendering as Trifecta.Rendering++default (AnsiDoc, Double, Integer)++-- | A HOAS representation of (possibly partially applied) values+-- in the environment.+data Term+ = TVal !Value+ | TLam (Term -> Result Term)++instance AnsiPretty Term where+ apretty = \case+ TLam _ -> "Function"+ TVal v -> bold (pp v)++-- | Fully apply two 'Term's.+qapply :: Delta -> Term -> Term -> Result Term+qapply d a b = case (a, b) of+ (TLam f, x) ->+ case f x of+ Failure e -> Failure (Trifecta.Delta.prettyDelta d <+> red "error:" <+> e)+ Success y -> pure y+ (TVal x, _) ->+ Failure $+ "unable to apply literal"+ <+> apretty a+ <+> "->"+ <+> apretty b+ </> pp x+{-# INLINEABLE qapply #-}++-- | Quote a primitive 'Value' from the top-level.+qprim :: (ToJSON a, Quote a) => a -> Term+qprim = quote "Value" 0+{-# INLINEABLE qprim #-}++class Unquote a where+ unquote :: Id -> Int -> Term -> Result a+ default unquote :: FromJSON a => Id -> Int -> Term -> Result a+ unquote k n = \case+ f@TLam {} -> typeErr k n (apretty f) "Value"+ TVal v ->+ case Aeson.fromJSON v of+ Aeson.Success x -> pure x+ Aeson.Error e -> argumentErr k n e+ {-# INLINEABLE unquote #-}++instance Unquote Value++instance Unquote Text++instance Unquote [Text]++instance Unquote Text.Lazy.Text++instance Unquote Bool++instance Unquote Double++instance Unquote Scientific++instance Unquote Object++instance Unquote Array++instance Unquote Int where+ unquote k n =+ unquote k n+ >=> maybe (typeErr k n "Double" "Int") pure+ . Scientific.toBoundedInteger+ {-# INLINEABLE unquote #-}++instance Unquote Integer where+ unquote k n =+ unquote k n+ >=> either (const (typeErr k n "Double" "Integral")) pure+ . (Scientific.floatingOrInteger :: Scientific -> Either Double Integer)+ {-# INLINEABLE unquote #-}++instance Unquote Collection where+ unquote k n q =+ text <$> unquote k n q+ <|> hashMap <$> unquote k n q+ <|> vector <$> unquote k n q+ where+ text t =+ Col (Text.length t)+ . map (\c -> (Nothing, String (Text.singleton c)))+ $ Text.unpack t++ hashMap m =+ Col (HashMap.size m)+ . map (Bifunctor.first Just)+ . sortBy (comparing fst)+ $ HashMap.toList m++ vector v = Col (Vector.length v) (Vector.map (Nothing,) v)+ {-# INLINEABLE unquote #-}++class Quote a where+ quote :: Id -> Int -> a -> Term+ default quote :: ToJSON a => Id -> Int -> a -> Term+ quote _ _ = TVal . Aeson.toJSON+ {-# INLINEABLE quote #-}++instance (Unquote a, Quote b) => Quote (a -> b) where+ quote k n f = TLam $ \x -> quote k n' . f <$> unquote k n' x+ where+ n' = succ n+ {-# INLINEABLE quote #-}++instance Quote Term where+ quote _ _ = id+ {-# INLINEABLE quote #-}++instance Quote Value++instance Quote [Value]++instance Quote Text++instance Quote [Text]++instance Quote Text.Lazy.Text++instance Quote Bool++instance Quote Int++instance Quote Integer++instance Quote Double++instance Quote Scientific++instance Quote Object++instance Quote Array++instance Quote Builder where+ quote k n = quote k n . Text.Builder.toLazyText+ {-# INLINEABLE quote #-}++typeErr :: Id -> Int -> AnsiDoc -> AnsiDoc -> Result a+typeErr k n x y = Failure $ "type" <+> pp k <+> pretty n <+> x <+> "::" <+> y++argumentErr :: Pretty a => Id -> Int -> a -> Result b+argumentErr k n e = Failure $ if self then app else arg+ where+ app =+ "unable to apply"+ <+> bold (pp k)+ <+> "to left hand side:"+ </> PP.indent 4 (pretty e </> Trifecta.Rendering.prettyRendering mark)++ arg =+ "invalid"+ <+> bold (pp $ toOrdinal (n - 1))+ <+> "argument to"+ <+> bold (pp k)+ <> ":"+ </> PP.indent 4 (pretty e </> Trifecta.Rendering.prettyRendering mark)++ mark =+ Trifecta.Rendering.renderingCaret (Trifecta.Delta.Columns col col) $+ "... | " <> Text.Encoding.encodeUtf8 k <> line++ col+ | self = 1+ | otherwise = fromIntegral (Text.length k + 4 + (n * 2))++ line+ | self = "\n"+ | otherwise =+ "(" <> ByteString.Char8.intercalate ", " (replicate (n - 1) "...") <> "\n"++ self = n <= 1
+ lib/Text/EDE/Internal/Syntax.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Text.EDE.Internal.Syntax+-- 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.Syntax where++import Control.Lens ((.~))+import Data.Function ((&))+import Data.HashSet (HashSet)+import qualified Data.HashSet as HashSet+import Text.EDE.Internal.Types+import Text.Parser.Token.Style (CommentStyle)+import qualified Text.Parser.Token.Style as Token+import Text.Trifecta (IdentifierStyle, TokenParsing)+import qualified Text.Trifecta as Trifecta++-- | The default ED-E syntax.+--+-- Delimiters:+--+-- * Pragma: @{! ... !}@+--+-- * Inline: @{{ ... }}@+--+-- * Comments: @{# ... #}@+--+-- * Blocks: @{% ... %}@+defaultSyntax :: Syntax+defaultSyntax =+ Syntax+ { _delimPragma = ("{!", "!}"),+ _delimInline = ("{{", "}}"),+ _delimComment = ("{#", "#}"),+ _delimBlock = ("{%", "%}")+ }++-- | An alternate syntax (based on Play/Scala templates) designed to+-- be used when the default is potentially ambiguous due to another encountered+-- smarty based syntax.+--+-- Delimiters:+--+-- * Inline: @\<\@ ... \@>@+--+-- * Comments: @\@* ... *\@@+--+-- * Blocks: @\@( ... )\@@+alternateSyntax :: Syntax+alternateSyntax =+ Syntax+ { _delimPragma = ("@!", "!@"),+ _delimInline = ("<@", "@>"),+ _delimComment = ("@*", "*@"),+ _delimBlock = ("@(", ")@")+ }++commentStyle :: String -> String -> CommentStyle+commentStyle s e =+ Token.emptyCommentStyle & Token.commentStart .~ s & Token.commentEnd .~ e++operatorStyle :: TokenParsing m => IdentifierStyle m+operatorStyle =+ Token.haskellOps & Trifecta.styleLetter .~ Trifecta.oneOf "-+!&|=><"++variableStyle :: TokenParsing m => IdentifierStyle m+variableStyle =+ keywordStyle & Trifecta.styleName .~ "variable"++keywordStyle :: TokenParsing m => IdentifierStyle m+keywordStyle =+ Token.haskellIdents+ & Trifecta.styleReserved .~ keywordSet+ & Trifecta.styleName .~ "keyword"++keywordSet :: HashSet String+keywordSet =+ HashSet.fromList+ [ "if",+ "elif",+ "else",+ "case",+ "when",+ "for",+ "include",+ "let",+ "endif",+ "endcase",+ "endfor",+ "endlet",+ "in",+ "with",+ "_",+ ".",+ "true",+ "false"+ ]++pragmaStyle :: TokenParsing m => IdentifierStyle m+pragmaStyle =+ Token.haskellIdents+ & Trifecta.styleReserved .~ pragmaSet+ & Trifecta.styleName .~ "pragma field"++pragmaSet :: HashSet String+pragmaSet =+ HashSet.fromList+ [ "pragma",+ "inline",+ "comment",+ "block"+ ]
+ lib/Text/EDE/Internal/Types.hs view
@@ -0,0 +1,242 @@+{-# 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 {unPP :: a}++pp :: AnsiPretty (PP a) => a -> AnsiDoc+pp = apretty . PP++(</>) :: Doc ann -> Doc ann -> Doc ann+x </> y = x <> PP.softline <> y++bold :: AnsiDoc -> AnsiDoc+bold = PP.annotate PP.bold++red :: AnsiDoc -> AnsiDoc+red = PP.annotate (PP.color PP.Red)++instance AnsiPretty (PP Text) where+ apretty = pretty . Text.unpack . unPP++instance AnsiPretty (PP Value) where+ apretty (PP v) =+ case v of+ Null -> "Null"+ Bool _ -> "Bool"+ Number _ -> "Scientific"+ Object _ -> "Object"+ Array _ -> "Array"+ String _ -> "String"++-- | The result of running parsing or rendering steps.+data Result a+ = Success a+ | Failure AnsiDoc+ deriving (Show, Functor, Foldable, Traversable)++$(Lens.makePrisms ''Result)++instance Monad Result where+ return = Success+ {-# INLINE return #-}++ Success x >>= k = k x+ Failure e >>= _ = Failure e+ {-# INLINE (>>=) #-}++instance Applicative Result where+ pure = return+ {-# INLINE pure #-}++ Success f <*> Success x = Success (f x)+ Success _ <*> Failure e = Failure e+ Failure e <*> Success _ = Failure e+ Failure e <*> Failure e' = Failure (PP.vsep [e, e'])+ {-# INLINE (<*>) #-}++instance Alternative Result where+ Success x <|> Success _ = Success x+ Success x <|> Failure _ = Success x+ Failure _ <|> Success x = Success x+ Failure e <|> Failure e' = Failure (PP.vsep [e, e'])+ {-# INLINE (<|>) #-}++ empty = Failure mempty+ {-# INLINE empty #-}++instance Show a => AnsiPretty (Result a) where+ apretty (Success x) = pretty (show x)+ apretty (Failure e) = 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 (Left . show) 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 _ g (Success x) = g x+result f _ (Failure e) = f e++-- | Convenience for returning a successful 'Result'.+success :: Monad m => a -> m (Result a)+success = return . Success++-- | Convenience for returning an error 'Result'.+failure :: Monad m => AnsiDoc -> m (Result a)+failure = return . Failure++type Delim = (String, String)++data Syntax = Syntax+ { _delimPragma :: !Delim,+ _delimInline :: !Delim,+ _delimComment :: !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+ { _tmplName :: !Text,+ _tmplExp :: !(Exp Delta),+ _tmplIncl :: HashMap Id (Exp Delta)+ }+ deriving (Eq)++type Id = Text++newtype Var = Var (NonEmpty Id)+ deriving (Eq)++instance AnsiPretty Var where+ apretty (Var is) =+ PP.hcat+ . PP.punctuate "."+ . map (PP.annotate PP.bold . pp)+ . reverse+ $ NonEmpty.toList is++instance Show Var where+ show = show . apretty++data Collection where+ Col :: Foldable f => Int -> f (Maybe Text, Value) -> Collection++data Pat+ = PWild+ | PVar !Var+ | PLit !Value+ deriving (Eq, 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 (Eq, Show, Functor)++instance Functor.Classes.Eq1 ExpF where+ liftEq _ (ELit a) (ELit b) = a == b+ liftEq _ (EVar a) (EVar b) = a == b+ liftEq _ (EFun a) (EFun b) = a == b+ liftEq c (EApp a1 a2) (EApp b1 b2) = a1 `c` b1 && a2 `c` b2+ liftEq c (ELet a0 a1 a2) (ELet b0 b1 b2) = a0 == b0 && a1 `c` b1 && a2 `c` b2+ liftEq c (ECase a as) (ECase b bs) = a `c` b && (List.all (uncurry altEq) $ zip as bs)+ where+ altEq (pA, a') (pB, b') = pA == pB && a' `c` b'+ liftEq c (ELoop a0 a1 a2) (ELoop b0 b1 b2) = a0 == b0 && a1 `c` b1 && a2 `c` b2+ liftEq _ (EIncl a) (EIncl b) = a == b+ liftEq _ _ _ = False++type Exp = Cofree ExpF++instance HasDelta (Exp Delta) where+ delta = Comonad.extract++-- | Unwrap a 'Value' to an 'Object' safely.+--+-- See Aeson\'s documentation for more details.+fromValue :: Value -> Maybe Object+fromValue (Object o) = Just o+fromValue _ = Nothing++-- | Create an 'Object' from a list of name/value 'Pair's.+--+-- See Aeson\'s documentation for more details.+fromPairs :: [Pair] -> Object+fromPairs xs =+ case Aeson.object xs of+ Object o -> o+ _other -> mempty
− src/Text/EDE.hs
@@ -1,698 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}---- Module : Text.EDE--- 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)---- | A (mostly logicless) textual templating language with similar syntax to--- <https://github.com/Shopify/liquid Liquid> or <http://jinja.pocoo.org/docs/ Jinja2>.------ (ED-E is a character from Fallout New Vegas, pronounced 'Eddie'.)-module Text.EDE- ( -- * How to use this library- -- $usage-- -- * Parsing and Rendering- -- $parsing_and_rendering- Template,-- -- ** Parsing- parse,- parseIO,- parseFile,- parseFileWith,- parseWith,-- -- ** Includes- -- $resolvers- Resolver,- Id,- includeMap,- includeFile,-- -- ** Rendering- render,- renderWith,-- -- ** Either Variants- eitherParse,- eitherParseFile,- eitherParseWith,- eitherRender,- eitherRenderWith,-- -- ** Results and Errors- -- $results- Delta (..),- Result (..),- eitherResult,- result,- success,- failure,-- -- * Input- -- $input- fromValue,- fromPairs,- (.=),-- -- * Version- version,-- -- * Syntax- Delim,- Syntax,- delimPragma,- delimInline,- delimComment,- delimBlock,- defaultSyntax,- alternateSyntax,-- -- ** Pragmas- -- $pragmas-- -- ** Expressions- -- $expressions-- -- ** Variables- -- $variables-- -- ** Conditionals- -- $conditionals-- -- ** Case Analysis- -- $case-- -- ** Loops- -- $loops-- -- ** Includes- -- $includes-- -- ** Filters- -- $filters-- -- ** Raw- -- $raw-- -- ** Comments- -- $comments-- -- ** Let Expressions- -- $let- )-where--import Control.Monad-import Data.Aeson ((.=))-import Data.Aeson.Types (Object)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import Data.Foldable (foldrM)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as Map-import Data.List.NonEmpty (NonEmpty (..))-#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup-#endif-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Lazy as LText-import Data.Text.Lazy.Builder (toLazyText)-import Data.Text.Prettyprint.Doc (Pretty (..))-import Data.Version (Version)-import qualified Paths_ede as Paths-import System.Directory-import System.FilePath-import qualified Text.EDE.Internal.Eval as Eval-import qualified Text.EDE.Internal.Parser as Parser-import Text.EDE.Internal.Quoting (Term)-import Text.EDE.Internal.Syntax-import Text.EDE.Internal.Types hiding ((</>))-import Text.Trifecta.Delta---- | ED-E Version.-version :: Version-version = Paths.version---- | Parse Lazy 'LText.Text' into a compiled 'Template'.------ Because this function is pure and does not resolve @include@s,--- encountering an @include@ expression during parsing will result in an 'Error'.------ See 'parseFile' or 'parseWith' for mechanisms to deal with @include@--- dependencies.-parse ::- -- | Strict 'ByteString' template definition.- ByteString ->- Result Template-parse = join . parseWith defaultSyntax (includeMap mempty) "Text.EDE.parse"---- | Parse 'Text' into a compiled 'Template'.------ This function handles all @include@ expressions as 'FilePath's and performs--- recursive loading/parsing.-parseIO ::- -- | Parent directory for relatively pathed includes.- FilePath ->- -- | Strict 'ByteString' template definition.- ByteString ->- IO (Result Template)-parseIO p = parseWith defaultSyntax (includeFile p) "Text.EDE.parse"---- | Load and parse a 'Template' from a file.------ This function handles all @include@ expressions as 'FilePath's and performs--- recursive loading/parsing, with pathing of @include@s relatively to the--- target (unless absolute paths are used).-parseFile ::- -- | Path to the template to load and parse.- FilePath ->- IO (Result Template)-parseFile = parseFileWith defaultSyntax---- | /See:/ 'parseFile'.-parseFileWith ::- -- | Delimiters and parsing options.- Syntax ->- -- | Path to the template to load and parse.- FilePath ->- IO (Result Template)-parseFileWith s p =- loadFile p- >>= result- failure- (parseWith s (includeFile (takeDirectory p)) (Text.pack p))---- | Parse a 'Template' from a Strict 'ByteString' using a custom function for--- resolving @include@ expressions.------ Two custom @include@ resolvers are supplied:------ * 'includeMap'------ * 'includeFile'------ 'parseFile' for example, is defined as: 'parseWith' 'includeFile'.-parseWith ::- Monad m =>- -- | Delimiters and parsing options.- Syntax ->- -- | Function to resolve includes.- Resolver m ->- -- | Strict 'Text' name.- Text ->- -- | Strict 'ByteString' template definition.- ByteString ->- m (Result Template)-parseWith o f n = result failure resolve . Parser.runParser o n- where- resolve (u, is) = do- r <- foldrM include (Success (Map.singleton n u)) (Map.toList is)- result- failure- (success . Template n u)- r-- -- Presuming self is always in self's includes, see singleton above.- -- FIXME: utilise the list of deltas for failures- include (_, _) (Failure e) = failure e- include (k, d :| _) (Success ss) =- f o k d- >>= result failure (success . mappend ss . _tmplIncl)---- | 'HashMap' resolver for @include@ expressions.------ The 'identifier' component of the @include@ expression is treated as a lookup--- key into the supplied 'HashMap'.--- If the 'identifier' doesn't exist in the 'HashMap', an 'Error' is returned.-includeMap ::- Monad m =>- -- | A 'HashMap' of named 'Template's.- HashMap Id Template ->- -- | Resolver for 'parseWith'.- Resolver m-includeMap ts _ k _- | Just v <- Map.lookup k ts = success v- | otherwise = failure ("unable to resolve " <> pretty (Text.unpack k))---- FIXME: utilise deltas in error messages---- | 'FilePath' resolver for @include@ expressions.------ The 'identifier' component of the @include@ expression is treated as a relative--- 'FilePath' and the template is loaded and parsed using 'parseFile'.--- If the 'identifier' doesn't exist as a valid 'FilePath', an 'Error' is returned.-includeFile ::- -- | Parent directory for relatively pathed includes.- FilePath ->- Resolver IO-includeFile p o k _ = loadFile f >>= result failure (parseWith o inc k)- where- inc = includeFile (takeDirectory f)-- f- | Text.null k = Text.unpack k- | otherwise = p </> Text.unpack k--loadFile :: FilePath -> IO (Result ByteString)-loadFile p = do- e <- doesFileExist p- if not e- then failure ("file " <> pretty p <> " doesn't exist.")- else BS.readFile p >>= success---- | Render an 'Object' using the supplied 'Template'.-render ::- -- | Parsed 'Template' to render.- Template ->- -- | Bindings to make available in the environment.- Object ->- Result LText.Text-render = renderWith mempty---- | Render an 'Object' using the supplied 'Template'.-renderWith ::- -- | Filters to make available in the environment.- HashMap Id Term ->- -- | Parsed 'Template' to render.- Template ->- -- | Bindings to make available in the environment.- Object ->- Result LText.Text-renderWith fs (Template _ u ts) = fmap toLazyText . Eval.render ts fs u---- | /See:/ 'parse'-eitherParse :: ByteString -> Either String Template-eitherParse = eitherResult . parse---- | /See:/ 'parseFile'-eitherParseFile :: FilePath -> IO (Either String Template)-eitherParseFile = fmap eitherResult . parseFile---- | /See:/ 'parseWith'-eitherParseWith ::- (Functor m, Monad m) =>- Syntax ->- Resolver m ->- Text ->- ByteString ->- m (Either String Template)-eitherParseWith o f n = fmap eitherResult . parseWith o f n---- | /See:/ 'render'-eitherRender ::- Template ->- Object ->- Either String LText.Text-eitherRender t = eitherResult . render t---- | /See:/ 'renderWith'-eitherRenderWith ::- HashMap Id Term ->- Template ->- Object ->- Either String LText.Text-eitherRenderWith fs t = eitherResult . renderWith fs t---- $usage------ A simple example of parsing and rendering 'Text' containing a basic conditional--- expression and variable interpolation follows.------ First the 'Template' is defined and parsed in the 'Result' monad:------ >>> tmpl <- parse "{% if var %}\nHello, {{ var }}!\n{% else %}\nnegative!\n{% endif %}\n" :: Result Template------ Then an 'Object' is defined containing the environment which will be--- available to the 'Template' during rendering:------ >>> let env = fromPairs [ "var" .= "World" ] :: Object------ Note: the 'fromPairs' function above is a wrapper over Aeson's 'object'--- which removes the outer 'Object' 'Value' constructor, exposing the underlying 'HashMap'.------ Then, the 'Template' is rendered using the 'Object' environment:------ >>> render tmpl env :: Result Text--- > Success "Hello, World!"------ In this manner, 'Template's can be pre-compiled to the internal AST and--- the cost of parsing can be amortised if the same 'Template' is rendered multiple times.------ Another example, this time rendering a 'Template' from a file:------ > import qualified Data.Text.Lazy as LText--- > import Text.EDE--- >--- > main :: IO ()--- > main = do--- > r <- eitherParseFile "template.ede"--- > either error print $ r >>= (`eitherRender` env)--- > where--- > env = fromPairs--- > [ "text" .= "Some Text."--- > , "int" .= 1--- > , "list" .= [5..10]--- > ]------ Please see the syntax section for more information about available--- statements and expressions.---- $parsing_and_rendering------ Parsing and rendering require two separate steps intentionally so that the--- more expensive (and potentially impure) action of parsing and resolving--- @include@s can be embedded and re-used in a pure fashion.------ * Parsing tokenises the input and converts it to an internal AST representation,--- resolving @include@s using a custom function. The result is a compiled template--- which can be cached for future use.------ * Rendering takes a 'HashMap' of custom 'Fun's (functions available in the--- template context), an 'Object' as the binding environment, and a parsed--- 'Template' to subsitute the values into.--- The result is a Lazy 'LText.Text' value containing the rendered output.---- $resolvers------ The 'Resolver' used to resolve @include@ expressions determines the purity--- of 'Template' parsing.------ For example, using the 'includeFile' 'Resolver' means parsing is restricted--- to 'IO', while pre-caching a 'HashMap' of 'Template's and supplying them to--- 'parseWith' using 'includeMap' offers a pure variant for @include@ resolution.---- $results------ The 'Result' of a 'parse' or 'render' steps can be inspected or analysed using--- 'result' as follows:------ >>> result failure success $ render tmpl env------ If you're only interested in dealing with errors as strings, and the positional--- information contained in 'Meta' is not of use you can use the convenience functions--- 'eitherParse', 'eitherRender', or convert a 'Result' to 'Either' using 'eitherResult'.------ >>> either failure success $ eitherParse tmpl---- $input------ 'fromPairs' (or 'fromValue') is a wrapper around Aeson's 'object' function which--- safely strips the outer 'Value' constructor, providing the correct type--- signature for input into 'render'.------ It is used in combination with the re-exported '.=' as follows:------ >>> render (fromPairs [ "foo" .= "value", "bar" .= 1 ]) :: Template -> Result Text---- #syntax#------- $pragmas------ Syntax can be modified either via the arguments to 'parseWith' or alternatively--- by specifying the delimiters via an @EDE_SYNTAX@ pragma.------ /Note:/ The pragmas must start on line1. Subsequently encountered--- pragmas are parsed as textual template contents.------ For example:------ > {! EDE_SYNTAX pragma=("{*", "*}") inline=("#@", "@#") comment=("<#", "#>") block=("$$", "$$") !}--- > {* EDE_SYNTAX block=("#[", "]#") *}--- > ...------ Would result in the following syntax:------ * Pragmas: @{* ... *}@------ * Inline: @\#\@ ... \@\#@------ * Comment: @\<\# ... \#>@------ * Block: @\#[ ... ]\#@------ /Note:/ @EDE_SYNTAX@ pragmas only take effect for the current template, not--- child includes. If you want to override the syntax for all templates use 'parseWith'--- and custom 'Syntax' settings.---- $expressions------ Expressions behave as any simplistic programming language with a variety of--- prefix, infix, and postifx operators available. (/See:/ "Text.EDE.Filters")------ A rough overview of the expression grammar:------ > expression ::= literal | identifier | '|' filter--- > filter ::= identifier--- > identifier ::= [a-zA-Z_]{1}[0-9A-Za-z_']*--- > object ::= '{' pairs '}'--- > pairs ::= string ':' literal | string ':' literal ',' pairs--- > array ::= '[' elements ']'--- > elements ::= literal | literal ',' elements--- > literal ::= object | array | boolean | number | string--- > boolean ::= true | false--- > number ::= integer | double--- > string ::= "char+|escape"------- /Note:/------- * Identifiers are named similarly to Haskell's rules.-------- * Booleans are lowered cased.-------- * The string quoting and escaping follows Haskell's rules.-------- * The Numeric format shares the same characteristics as the <http://json.org/ JSON specification.>---- $variables------ Variables are substituted directly for their renderable representation.--- An error is raised if the varaible being substituted is not a literal type--- (ie. an 'Array' or 'Object') or doesn't exist in the supplied environment.------ > {{ var }}------ Nested variable access is also supported for variables which resolve to an 'Object'.--- Dot delimiters are used to chain access through multiple nested 'Object's.--- The right-most accessor must resolve to a renderable type as with the previous--- non-nested variable access.------ > {{ nested.var.access }}---- $conditionals------ A conditional is introduced and completed with the section syntax:------ > {% if <expr1> %}--- > ... consequent expressions--- > {% elif <expr2> %}--- > ... consequent expressions--- > {% elif <expr3> %}--- > ... consequent expressions--- > {% else %}--- > ... alternate expressions--- > {% endif %}------ The boolean result of the @expr@ determines the branch that is rendered by--- the template with multiple (or none) elif branches supported, and the--- else branch being optional.------ In the case of a literal it conforms directly to the supported boolean or relation logical--- operators from Haskell.--- If a variable is singularly used its existence determines the result of the predicate;--- the exception to this rule is boolean values which will be substituted into the--- expression if they exist in the supplied environment.------ The following logical expressions are supported as predicates in conditional statements--- with parameters type checked and an error raised if the left and right--- hand sides are not type equivalent.------ * @And@: '&&'------ * @Or@: '||'------ * @Equal@: '=='------ * @Not Equal@: @!=@ (/See:/ '/=')------ * @Greater@: '>'------ * @Greater Or Equal@: '>='------ * @Less@: '<'------ * @Less Or Equal@: '<='------ * @Negation@: @!@ (/See:/ 'not')------ /See:/ "Text.EDE.Filters"---- $case------ To pattern match a literal or variable, you can use the @case@ statement:------ > {% case var %}--- > {% when "a" %}--- > .. matched expressions--- > {% when "b" %}--- > .. matched expressions--- > {% else %}--- > .. alternate expressions--- > {% endcase %}------ Patterns take the form of @variables@, @literals@, or the wild-card--- '@_@' pattern (which matches anything).---- $loops------ Iterating over an 'Array' or 'Object' can be acheived using the 'for ... in' section syntax.--- Attempting to iterate over any other type will raise an error.------ Example:------ > {% for var in list %}--- > ... iteration expression--- > {% else %}--- > ... alternate expression--- > {% endfor %}------ The iteration branch is rendering per item with the else branch being (which is optional)--- being rendered if the @{{ list }}@ variable is empty.------ When iterating over an 'Object', a stable sort using key equivalence is applied, 'Array's--- are unmodified.------ The resulting binding within the iteration expression (in this case, @{{ var }}@) is--- an 'Object' containing the following keys:------ * @key :: Text@: They key if the loop target is an 'Object'------ * @value :: a@: The value of the loop target------ * @loop :: Object@: Loop metadata.------ * @length :: Int@: Length of the loop------ * @index :: Int@: Index of the iteration------ * @index0 :: Int@: Zero based index of the iteration------ * @remainder :: Int@: Remaining number of iterations------ * @remainder0 :: Int@: Zero based remaining number of iterations------ * @first :: Bool@: Is this the first iteration?------ * @last :: Bool@: Is this the last iteration?------ * @odd :: Bool@: Is this an odd iteration?------ * @even :: Bool@: Is this an even iteration?------ For example:------ > {% for item in items %}--- > {{ item.index }}:{{ item.value }}--- > {% if !item.last %}--- >--- > {% endif %}--- > {% endfor %}------ Will render each item with its (1-based) loop index as a prefix, separated--- by a blank newline, without a trailing at the end of the document.------ Valid loop targets are 'Object's, 'Array's, and 'String's, with only 'Object's--- having an available @{{ <var>.key }}@ in scope.---- $includes------ Includes are a way to reduce the amount of noise in large templates.--- They can be used to abstract out common snippets and idioms into partials.------ If 'parseFile' or the 'includeFile' resolver is used, templates will be loaded--- using 'FilePath's. (This is the default.)------ For example:------ > {% include "/var/tmp/partial.ede" %}------ Loads @partial.ede@ from the file system.------ The current environment is made directly available to the included template.--- Additional bindings can be created (/See:/ @let@) which will be additionally--- available only within the include under a specific identifier:------ > {% include "/var/tmp/partial.ede" with some_number = 123 %}------ Includes can also be resolved using pure 'Resolver's such as 'includeMap',--- which will treat the @include@ expression's identifier as a 'HashMap' key:------ > {% include "arbitrary_key" %}------ Uses 'Map.lookup' to find @arbitrary_key@ in the 'HashMap' supplied to 'includeMap'.---- $filters------ Filters are typed functions which can be applied to variables and literals.--- An example of rendering a lower cased boolean would be:------ > {{ true | show | lower }}------ The input is on the LHS and chained filters (delimited by the pipe operator @|@)--- are on the RHS, with filters being applied postfix, left associatively.------ /See:/ "Text.EDE.Filters"---- $raw------ You can disable template processing for blocks of text using the @raw@ section:------ > {% raw %}--- > Some {{{ handlebars }}} or {{ mustache }} or {{ jinja2 }} output tags etc.--- > {% endraw %}------ This can be used to avoid parsing expressions which would otherwise be--- considered valid @ED-E@ syntax.---- $comments------ Comments are ignored by the parser and omitted from the rendered output.------ > {# singleline comment #}------ > {#--- > multiline--- > comment--- > #}---- $let------ You can also bind an identifier to values which will be available within--- the following expression scope.------ For example:------ > {% let var = false %}--- > ...--- > {{ var }}--- > ...--- > {% endlet %}
− src/Text/EDE/Filters.hs
@@ -1,219 +0,0 @@--- Module : Text.EDE.Filters--- 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)---- | The means to construct your own filters.-module Text.EDE.Filters- ( -- * Prelude- -- $prelude-- -- ** Boolean- -- $boolean-- -- ** Equality- -- $equality-- -- ** Relational- -- $relational-- -- ** Numeric- -- $numeric-- -- ** Fractional- -- $fractional-- -- ** Textual- -- $textual-- -- ** Collection- -- $collection-- -- ** Polymorphic- -- $polymorphic-- -- * Constructing filters- Term (..),-- -- ** Classes- Quote (..),- Unquote (..),-- -- ** Restricted quoters- (@:),- qapply,- qpoly2,- qnum1,- qnum2,- qcol1,-- -- ** Errors- typeErr,- argumentErr,- )-where--import Text.EDE.Internal.Filters-import Text.EDE.Internal.Quoting---- $prelude------ The default filters available to a template are documented by the subsequent categories.------ These filters cannot be overriden and attempting to supply your own filters to--- 'Text.EDE.renderWith' will cause the similarly named filters to disappear when--- they are merged with the prelude during evaluation. (/See:/ 'Data.HashMap.Strict.union')---- $boolean------ [@! :: Bool -> Bool@]--- /See:/ 'not'------ [@'&&' :: Bool -> Bool -> Bool@]------ [@'||' :: Bool -> Bool -> Bool@]---- $equality------ [@'==' :: a -> a -> Bool@]------ [@!= :: a -> a -> Bool@]--- /See/: '/='---- $relational------ [@'>' :: a -> a -> Bool@]------ [@'>=' :: a -> a -> Bool@]------ [@'<=' :: a -> a -> Bool@]------ [@'<' :: a -> a -> Bool@]---- $numeric------ [@'+' :: Scientific -> Scientific -> Scientific@]------ [@'-' :: Scientific -> Scientific -> Scientific@]------ [@'*' :: Scientific -> Scientific -> Scientific@]------ [@'abs' :: Scientific -> Scientific@]------ [@'negate' :: Scientific -> Scientific@]------ [@'signum' :: Scientific -> Scientific@]---- $fractional------ [@'ceiling' :: Scientific -> Scientific@]------ [@'floor' :: Scientific -> Scientific@]------ [@'round' :: Scientific -> Scientific@]------ [@'truncate' :: Scientific -> Scientific@]---- $textual------ [@dropLower :: Text -> Text@]--- Drop preceding lowercase characters.------ [@'dropUpper' :: Text -> Text@]--- Drop preceding uppercase characters.------ [@'Data.Text.Manipulate.indentLines' :: Text -> Text@]------ [@'Data.Text.Manipulate.prependLines' :: Text -> Text@]------ [@'Data.Text.justifyLeft' :: Text -> Text@]--- Using whitespace as fill character.------ [@'Data.Text.justifyRight' :: Text -> Text@]--- Using whitespace as fill character.------ [@'Data.Text.center' :: Text -> Text@]--- Using whitespace as fill character.------ [@'Data.Text.replace' :: Text -> Text@]------ [@remove@ @:: Text -> Text@]--- Shortcut for: @replace(pattern, "")@------ [@'Data.Text.Manipulate.splitWords' :: Text -> Text@]------ [@'Data.Text.strip' :: Text -> Text@]------ [@'Data.Text.stripPrefix' :: Text -> Text@]------ [@'Data.Text.stripSuffix' :: Text -> Text@]------ [@'Data.Text.stripStart' :: Text -> Text@]------ [@'Data.Text.stripEnd' :: Text -> Text@]------ [@'Data.Text.Manipulate.takeWord' :: Text -> Text@]------ [@'Data.Text.Manipulate.dropWord' :: Text -> Text@]------ [@'Data.Text.Manipulate.lowerHead' :: Text -> Text@]------ [@'Data.Text.Manipulate.upperHead' :: Text -> Text@]------ [@'Data.Text.Manipulate.toCamel' :: Text -> Text@]------ [@'Data.Text.Manipulate.toEllipsis' :: Text -> Text@]------ [@'Data.Text.Manipulate.toEllipsisWith' :: Text -> Text@]------ [@'Data.Text.Manipulate.toPascal' :: Text -> Text@]------ [@'Data.Text.Manipulate.toSnake' :: Text -> Text@]------ [@'Data.Text.Manipulate.toSpinal' :: Text -> Text@]------ [@'Data.Text.Manipulate.toTitle' :: Text -> Text@]------ [@'Data.Text.Manipulate.toTrain' :: Text -> Text@]------ [@'Data.Text.toLower' :: Text -> Text@]------ [@'Data.Text.toUpper' :: Text -> Text@]------ [@'Data.Text.Manipulate.toOrdinal' :: Scientific -> Text@]---- $collection------ [@length :: Collection -> Scientific@]--- /See/: Text.'Data.Text.length', Vector.'Data.Vector.length', HashMap.'Data.HashMap.Strict.size'------ [@empty :: Collection -> Bool@]--- /See/: Text.'Data.Text.null', Vector.'Data.Vector.null', HashMap.'Data.HashMap.Strict.null'------ [@reverse :: Collection -> Scientific@]--- /See/: Text.'Data.Text.reverse', Vector.'Data.Vector.reverse'------ [@head :: Collection -> Scientific@]--- /See/: Text.'Data.Text.head', Vector.'Data.Vector.head'------ [@last :: Collection -> Scientific@]--- /See/: Text.'Data.Text.last', Vector.'Data.Vector.last'------ [@tail :: Collection -> Scientific@]--- /See/: Text.'Data.Text.tail', Vector.'Data.Vector.tail'------ [@init@ @:: Collection -> Scientific@]--- /See/: Text.'Data.Text.init', Vector.'Data.Vector.init'------ [@'Data.HashMap.Strict.keys' :: Collection -> Scientific@]------ [@'Data.HashMap.Strict.elems' :: Collection -> Scientific@]---- $polymorphic------ [@'show' :: a -> Text@]
− src/Text/EDE/Internal/AST.hs
@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}---- Module : Text.EDE.Internal.AST--- 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)---- | AST smart constructors.-module Text.EDE.Internal.AST where--import Control.Comonad-import Control.Comonad.Cofree-import Data.Aeson.Types-import Data.Foldable-import Data.List.NonEmpty (NonEmpty (..))-import Data.Maybe-import Text.EDE.Internal.Types--newtype Mu f = Mu (f (Mu f))--cofree :: Functor f => a -> Mu f -> Cofree f a-cofree x = go- where- go (Mu f) = x :< fmap go f--var :: Id -> Var-var = Var . (:| [])--eapp :: a -> [Exp a] -> Exp a-eapp x [] = cofree x blank-eapp _ [e] = e-eapp _ (e : es) = foldl' (\x y -> extract x :< EApp x y) e es--efun :: Id -> Exp a -> Exp a-efun i e = let x = extract e in x :< EApp (x :< EFun i) e--efilter :: Exp a -> (Id, [Exp a]) -> Exp a-efilter e (i, ps) = let x = extract e in eapp x ((x :< EFun i) : e : ps)--elet :: Maybe (Id, Exp a) -> Exp a -> Exp a-elet m e = maybe e (\(i, b) -> extract b :< ELet i b e) m--ecase ::- Exp a ->- [Alt (Exp a)] ->- Maybe (Exp a) ->- Exp a-ecase p ws f = extract p :< ECase p (ws ++ maybe [] ((: []) . wild) f)--eif ::- (Exp a, Exp a) ->- [(Exp a, Exp a)] ->- Maybe (Exp a) ->- Exp a-eif t ts f = foldr' c (fromMaybe (extract (fst t) `cofree` blank) f) (t : ts)- where- c (p, w) e = extract p :< ECase p [true w, false e]--eempty :: Exp a -> Exp a -> Maybe (Exp a) -> Exp a-eempty v e = maybe e (eif (efun "!" (efun "empty" v), e) [] . Just)--true, false, wild :: Exp a -> Alt (Exp a)-true = (PLit (Bool True),)-false = (PLit (Bool False),)-wild = (PWild,)--blank :: Mu ExpF-blank = Mu (ELit (String mempty))
− src/Text/EDE/Internal/Eval.hs
@@ -1,222 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}---- Module : Text.EDE.Internal.Eval--- 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)--module Text.EDE.Internal.Eval where--import Control.Comonad.Cofree-import Control.Monad-import Control.Monad.Reader-import Data.Aeson hiding (Result (..))-import Data.Foldable (foldlM)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as Map-import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NonEmpty-import Data.Scientific (isFloating)-import qualified Data.Text as Text-import Data.Text.Lazy.Builder (Builder)-import qualified Data.Text.Lazy.Builder as Text.Builder-import Data.Text.Lazy.Builder.Scientific-import Data.Text.Manipulate (toOrdinal)-import Data.Text.Prettyprint.Doc ((<+>))-import qualified Data.Text.Prettyprint.Doc as PP-import Text.EDE.Internal.Filters (stdlib)-import Text.EDE.Internal.Quoting-import Text.EDE.Internal.Types-import Text.Trifecta.Delta--data Env = Env- { _templates :: HashMap Id (Exp Delta),- _quoted :: HashMap Id Term,- _values :: HashMap Id Value- }--type Context = ReaderT Env Result--render ::- HashMap Id (Exp Delta) ->- HashMap Id Term ->- Exp Delta ->- HashMap Id Value ->- Result Builder-render ts fs e o = runReaderT (eval e >>= nf) (Env ts (stdlib <> fs) o)- where- nf (TVal v) = build (delta e) v- nf _ =- lift $- Failure- "unable to evaluate partially applied template to normal form."--eval :: Exp Delta -> Context Term-eval (_ :< ELit l) = return (qprim l)-eval (d :< EVar v) = quote (Text.pack (show v)) 0 <$> variable d v-eval (d :< EFun i) = do- q <- Map.lookup i <$> asks _quoted- maybe- (throwError d $ "filter" <+> bold (pp i) <+> "doesn't exist.")- return- q-eval (_ :< EApp (_ :< EFun "defined") e) = predicate e-eval (d :< EApp a b) = do- x <- eval a- y <- eval b- binding d x y-eval (_ :< ELet k rhs bdy) = do- q <- eval rhs- v <- lift (unquote k 0 q)- bind (Map.insert k v) (eval bdy)---- FIXME: We have to recompute c everytime due to the predicate ..-eval (d :< ECase p ws) = go ws- where- go [] = return (qprim (String mempty))- go ((a, e) : as) =- case a of- PWild -> eval e- PVar v -> eval (d :< EVar v) >>= cond e as- PLit l -> eval (d :< ELit l) >>= cond e as-- cond e as y@(TVal Bool {}) = do- x <- predicate p- if x `eq` y- then eval e- else go as- cond e as y@TVal {} = do- x <- eval p- if x `eq` y- then eval e- else go as- cond _ as _ = go as-- eq (TVal a) (TVal b) = a == b- eq _ _ = False-eval (_ :< ELoop i v bdy) = eval v >>= lift . unquote i 0 >>= loop- where- d = delta bdy-- loop :: Collection -> Context Term- loop (Col l xs) = snd <$> foldlM iter (1, qprim (String mempty)) xs- where- iter (n, p) x = do- shadowed n- q <- bind (Map.insert i (context n x)) (eval bdy)- r <- binding d p q- return (n + 1, r)-- shadowed n = do- m <- asks _values- maybe- (return ())- (shadowedErr n)- (Map.lookup i m)-- shadowedErr n x =- throwError d $- "variable"- <+> bold (pp i)- <+> "shadows"- <+> pp x- <+> "in"- <+> pp (toOrdinal n)- <+> "loop iteration."-- context n (k, x) =- object $- [ "value" .= x,- "length" .= l,- "index" .= n,- "index0" .= (n - 1),- "remainder" .= (l - n),- "remainder0" .= (l - n - 1),- "first" .= (n == 1),- "last" .= (n == l),- "odd" .= (n `mod` 2 == 1),- "even" .= (n `mod` 2 == 0)- ]- ++ key k-- key (Just k) = ["key" .= k]- key Nothing = []-eval (d :< EIncl i) = do- ts <- asks _templates- case Map.lookup i ts of- Just e -> eval e- Nothing ->- throwError d $- "template"- <+> bold (pp i)- <+> "is not in scope:"- <+> PP.brackets (pp (Text.intercalate "," $ Map.keys ts))--bind :: (Object -> Object) -> Context a -> Context a-bind f = withReaderT (\x -> x {_values = f (_values x)})--variable :: Delta -> Var -> Context Value-variable d (Var is) = asks _values >>= go (NonEmpty.toList is) [] . Object- where- go [] _ v = return v- go (k : ks) r v = do- m <- nest v- maybe- (throwError d $ "variable" <+> apretty cur <+> "doesn't exist.")- (go ks (k : r))- (Map.lookup k m)- where- cur = Var (k :| r)-- nest :: Value -> Context Object- nest (Object o) = return o- nest x =- throwError d $- "variable"- <+> apretty cur- <+> "::"- <+> pp x- <+> "doesn't supported nested accessors."---- | A variable can be tested for truthiness, but a non-whnf expr cannot.-predicate :: Exp Delta -> Context Term-predicate x = do- r <- runReaderT (eval x) <$> ask- lift $ case r of- Success q- | TVal Bool {} <- q -> Success q- Success q- | TVal Null <- q -> Success (qprim False)- Success _ -> Success (qprim True)- Failure _- | _ :< EVar {} <- x -> Success (qprim False)- Failure e -> Failure e--binding :: Delta -> Term -> Term -> Context Term-binding d x y =- case (x, y) of- (TVal l, TVal r) -> quote "<>" 0 <$> liftM2 (<>) (build d l) (build d r)- _ -> lift (qapply d x y)--build :: Delta -> Value -> Context Builder-build _ Null = return mempty-build _ (String t) = return (Text.Builder.fromText t)-build _ (Bool True) = return "true"-build _ (Bool False) = return "false"-build _ (Number n)- | isFloating n = return (formatScientificBuilder Fixed Nothing n)- | otherwise = return (formatScientificBuilder Fixed (Just 0) n)-build d x =- throwError d ("unable to render literal" <+> pp x)---- FIXME: Add delta information to the thrown error document.-throwError :: Delta -> AnsiDoc -> Context a-throwError d doc = lift . Failure $ prettyDelta d <+> red "error:" <+> doc
− src/Text/EDE/Internal/Filters.hs
@@ -1,196 +0,0 @@-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}---- Module : Text.EDE.Internal.Filters--- 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)--module Text.EDE.Internal.Filters where--import Data.Aeson- ( Array,- Object,- Value (..),- encode,- )-import qualified Data.Char as Char-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as Map-import Data.Maybe-import Data.Scientific (Scientific)-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Lazy as LText-import qualified Data.Text.Lazy.Encoding as LText-import Data.Text.Manipulate-import Data.Text.Prettyprint.Doc ((<+>))-import qualified Data.Text.Unsafe as Text-import qualified Data.Vector as Vector-import Text.EDE.Internal.Quoting-import Text.EDE.Internal.Types--default (Integer)--stdlib :: HashMap Text Term-stdlib =- Map.fromList- -- boolean- [ "!" @: not,- "&&" @: (&&),- "||" @: (||),- -- equality- "==" `qpoly2` (==),- "!=" `qpoly2` (/=),- -- relational- ">" `qnum2` (>),- ">=" `qnum2` (>=),- "<=" `qnum2` (<=),- "<" `qnum2` (<),- -- numeric- "+" `qnum2` (+),- "-" `qnum2` (-),- "*" `qnum2` (*),- "abs" `qnum1` abs,- "signum" `qnum1` signum,- "negate" `qnum1` negate,- -- fractional- "truncate" `qnum1` (fromIntegral . truncate),- "round" `qnum1` (fromIntegral . round),- "ceiling" `qnum1` (fromIntegral . ceiling),- "floor" `qnum1` (fromIntegral . floor),- -- text- "lowerHead" @: lowerHead,- "upperHead" @: upperHead,- "toTitle" @: toTitle,- "toCamel" @: toCamel,- "toPascal" @: toPascal,- "toSnake" @: toSnake,- "toSpinal" @: toSpinal,- "toTrain" @: toTrain,- "toUpper" @: Text.toUpper,- "toLower" @: Text.toLower,- "toOrdinal" @: (toOrdinal :: Integer -> Text),- "dropLower" @: Text.dropWhile (not . Char.isUpper),- "dropUpper" @: Text.dropWhile (not . Char.isLower),- "takeWord" @: takeWord,- "dropWord" @: dropWord,- "splitWords" @: splitWords,- "strip" @: Text.strip,- "stripPrefix" @: (\x p -> fromMaybe x (p `Text.stripPrefix` x)),- "stripSuffix" @: (\x s -> fromMaybe x (s `Text.stripSuffix` x)),- "stripStart" @: Text.stripStart,- "stripEnd" @: Text.stripEnd,- "replace" @: flip Text.replace,- "remove" @: (\x r -> Text.replace r "" x),- "toEllipsis" @: flip toEllipsis,- "toEllipsisWith" @: (\x n e -> toEllipsisWith n e x),- "indentLines" @: flip indentLines,- "prependLines" @: flip prependLines,- "justifyLeft" @: (\x n -> Text.justifyLeft n ' ' x),- "justifyRight" @: (\x n -> Text.justifyRight n ' ' x),- "center" @: (\x n -> Text.center n ' ' x),- -- sequences- qcol1 "length" Text.length Map.size Vector.length,- qcol1 "empty" Text.null Map.null Vector.null,- qcol1 "reverse" Text.reverse id Vector.reverse,- -- lists- qlist1 "head" headT headV,- qlist1 "last" lastT lastV,- qlist1 "tail" tailT tailV,- qlist1 "init" initT initV,- "at" @: (\x i -> x Vector.! i :: Value),- -- object- "keys" @: (Map.keys :: Object -> [Text]),- "elems" @: (Map.elems :: Object -> [Value]),- -- , "map" @: undefined- -- , "filter" @: undefined- -- , "zip" @: undefined- -- , "join" @: undefined-- -- polymorphic- "show" @: (LText.decodeUtf8 . encode :: Value -> LText.Text),- "singleton" @: (pure :: Value -> Vector.Vector Value)- -- FIXME: existence checks currently hardcoded into the evaluator:- -- "default"- -- "defined"- ]--(@:) :: Quote a => Id -> a -> (Id, Term)-k @: q = (k, quote k 0 q)---- | Quote a binary function which takes the most general binding value.-qpoly2 :: Quote a => Id -> (Value -> Value -> a) -> (Id, Term)-qpoly2 k = (k,) . quote k 0---- | Quote an unary numeric function.-qnum1 :: Id -> (Scientific -> Scientific) -> (Id, Term)-qnum1 k = (k,) . quote k 0---- | Quote a binary numeric function.-qnum2 :: Quote a => Id -> (Scientific -> Scientific -> a) -> (Id, Term)-qnum2 k = (k,) . quote k 0---- | Quote a comprehensive set of unary functions to create a binding--- that supports list collection types.-qlist1 ::- (Quote a, Quote b) =>- Id ->- (Text -> a) ->- (Array -> b) ->- (Id, Term)-qlist1 k f g = (k,) . TLam $ \case- TVal (String t) -> pure . quote k 0 $ f t- TVal (Array v) -> pure . quote k 0 $ g v- x ->- Failure $- "when expecting a String or Array, encountered" <+> apretty x---- | Quote a comprehensive set of unary functions to create a binding--- that supports all collection types.-qcol1 ::- (Quote a, Quote b, Quote c) =>- Id ->- (Text -> a) ->- (Object -> b) ->- (Array -> c) ->- (Id, Term)-qcol1 k f g h = (k,) . TLam $ \case- TVal (String t) -> pure . quote k 0 $ f t- TVal (Object o) -> pure . quote k 0 $ g o- TVal (Array v) -> pure . quote k 0 $ h v- x ->- Failure $- "when expecting a String, Object, or Array, encountered" <+> apretty x--headT, lastT, tailT, initT :: Text -> Value-headT = text (Text.singleton . Text.unsafeHead)-lastT = text (Text.singleton . Text.last)-tailT = text Text.unsafeTail-initT = text Text.init--headV, lastV, tailV, initV :: Array -> Value-headV = vec Vector.unsafeHead-lastV = vec Vector.unsafeLast-tailV = vec (Array . Vector.unsafeTail)-initV = vec (Array . Vector.unsafeInit)--text :: (Text -> Text) -> Text -> Value-text f = String . safe mempty Text.null f--vec :: (Array -> Value) -> Array -> Value-vec = safe (Array Vector.empty) Vector.null--safe :: b -> (a -> Bool) -> (a -> b) -> a -> b-safe v f g x- | f x = v- | otherwise = g x
− src/Text/EDE/Internal/Parser.hs
@@ -1,388 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-}---- Module : Text.EDE.Internal.Parser--- 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)--module Text.EDE.Internal.Parser where--import Control.Applicative-import Control.Comonad (extract)-import Control.Comonad.Cofree-import Control.Lens hiding (both, noneOf, op, (:<))-import Control.Monad.State.Strict-import Data.Aeson.Types (Array, Object, Value (..))-import Data.Bifunctor-import Data.ByteString (ByteString)-import Data.Char (isSpace)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as Map-import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NonEmpty-import Data.Scientific-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import qualified Data.Vector as Vector-import Text.EDE.Internal.AST-import Text.EDE.Internal.Syntax-import Text.EDE.Internal.Types-import Text.Parser.Expression-import Text.Parser.LookAhead-import Text.Parser.Token.Style (buildSomeSpaceParser)-import Text.Trifecta hiding (Parser, Result (..), spaces)-import qualified Text.Trifecta as Tri-import Text.Trifecta.Delta--data Env = Env- { _settings :: !Syntax,- _includes :: HashMap Text (NonEmpty Delta)- }--makeLenses ''Env--instance HasSyntax Env where- syntax = settings--type Parser m =- ( Monad m,-#if MIN_VERSION_base(4,13,0)- MonadFail m,-#endif- MonadState Env m,- TokenParsing m,- DeltaParsing m,- LookAheadParsing m,- Errable m- )--newtype EDE a = EDE {runEDE :: Tri.Parser a}- deriving- ( Functor,- Applicative,- Alternative,- Monad,-#if MIN_VERSION_base(4,13,0)- MonadFail,-#endif- MonadPlus,- Parsing,- CharParsing,- DeltaParsing,- LookAheadParsing,- Errable- )--instance TokenParsing EDE where- nesting (EDE m) = EDE (nesting m)- {-# INLINE nesting #-}-- someSpace = skipMany (satisfy $ \c -> c /= '\n' && isSpace c)- {-# INLINE someSpace #-}-- semi = EDE semi- {-# INLINE semi #-}-- highlight h (EDE m) = EDE (highlight h m)- {-# INLINE highlight #-}--instance Errable (StateT Env EDE) where- raiseErr = lift . raiseErr--runParser ::- Syntax ->- Text ->- ByteString ->- Result (Exp Delta, HashMap Text (NonEmpty Delta))-runParser o n = res . parseByteString (runEDE run) pos- where- run = runStateT (pragma *> document <* eof) (Env o mempty)- pos = Directed (Text.encodeUtf8 n) 0 0 0 0-- res (Tri.Success x) = Success (_includes `second` x)- res (Tri.Failure e) = Failure $ _errDoc e--pragma :: Parser m => m ()-pragma = void . many $ do- !xs <- pragmal *> symbol "EDE_SYNTAX" *> sepBy field spaces <* trimr pragmar- mapM_ (uncurry assign) xs- where- field = (,) <$> setter <* symbol "=" <*> parens delim-- delim = (,) <$> stringLiteral <* symbol "," <*> stringLiteral-- setter =- pragmak "pragma" *> pure delimPragma- <|> pragmak "inline" *> pure delimInline- <|> pragmak "comment" *> pure delimComment- <|> pragmak "block" *> pure delimBlock--document :: Parser m => m (Exp Delta)-document = eapp <$> position <*> many (statement <|> inline <|> fragment)--inline :: Parser m => m (Exp Delta)-inline = between inlinel inliner term--fragment :: Parser m => m (Exp Delta)-fragment = ann (ELit <$> pack (notFollowedBy end0 >> try line0 <|> line1))- where- line0 = manyTill1 (noneOf "\n") (try (lookAhead end0) <|> eof)- line1 = manyEndBy1 anyChar newline-- end0 = void (inlinel <|> blockl <|> try end1)- end1 = multiLine (pure ()) (manyTill1 anyChar (lookAhead blockr))--statement :: Parser m => m (Exp Delta)-statement =- choice- [ ifelif,- cases,- loop,- include,- binding,- raw,- comment- ]--block :: Parser m => String -> m a -> m a-block k p = try (multiLine (keyword k) p) <|> singleLine (keyword k) p--multiLine :: Parser m => m b -> m a -> m a-multiLine s = between (try (triml blockl *> s)) (trimr blockr)--singleLine :: Parser m => m b -> m a -> m a-singleLine s = between (try (blockl *> s)) blockr--ifelif :: Parser m => m (Exp Delta)-ifelif =- eif- <$> branch "if"- <*> many (branch "elif")- <*> else'- <* exit "endif"- where- branch k = (,) <$> block k term <*> document--cases :: Parser m => m (Exp Delta)-cases =- ecase- <$> block "case" term- <*> many- ( (,) <$> block "when" pattern- <*> document- )- <*> else'- <* exit "endcase"--loop :: Parser m => m (Exp Delta)-loop = do- (i, v) <-- block- "for"- ( (,) <$> identifier- <*> (keyword "in" *> collection)- )- d <- document- eempty v (extract v :< ELoop i v d)- <$> else'- <* exit "endfor"--include :: Parser m => m (Exp Delta)-include = block "include" $ do- d <- position- k <- stringLiteral- includes %= Map.insertWith (<>) k (d :| [])- elet <$> scope <*> pure (d :< EIncl k)- where- scope =- optional $- (,) <$> (keyword "with" *> identifier)- <*> (symbol "=" *> term)--binding :: Parser m => m (Exp Delta)-binding =- elet . Just- <$> block- "let"- ( (,) <$> identifier- <*> (symbol "=" *> term)- )- <*> document- <* exit "endlet"--raw :: Parser m => m (Exp Delta)-raw = ann (ELit <$> body)- where- body = start *> pack (manyTill anyChar (lookAhead end)) <* end- start = block "raw" (pure ())- end = exit "endraw"---- FIXME: this is due to the whitespace sensitive nature of the parser making--- it difficult to do what most applicative parsers do by skipping comments--- as part of the whitespace.-comment :: Parser m => m (Exp Delta)-comment = ann (ELit <$> pure (String mempty) <* (try (triml (trimr go)) <|> go))- where- go =- (commentStyle <$> commentl <*> commentr)- >>= buildSomeSpaceParser (fail "whitespace significant")--else' :: Parser m => m (Maybe (Exp Delta))-else' = optional (block "else" (pure ()) *> document)--exit :: Parser m => String -> m ()-exit k = block k (pure ())--pattern :: Parser m => m Pat-pattern = PWild <$ char '_' <|> PVar <$> variable <|> PLit <$> literal--term :: Parser m => m (Exp Delta)-term = chainl1' term0 (try filter') (symbol "|" *> pure efilter) <|> term0--term0 :: Parser m => m (Exp Delta)-term0 = buildExpressionParser table expr- where- table =- [ [prefix "!"],- [infix' "*", infix' "/"],- [infix' "-", infix' "+"],- [infix' "==", infix' "!=", infix' ">", infix' ">=", infix' "<", infix' "<="],- [infix' "&&"],- [infix' "||"]- ]-- prefix n = Prefix (efun <$ operator n <*> pure n)-- infix' n =- Infix- ( do- d <- operator n- return $ \l r ->- d :< EApp (efun n l) r- )- AssocLeft-- expr =- parens term- <|> ann (EVar <$> variable)- <|> ann (ELit <$> literal)--filter' :: Parser m => m (Id, [Exp Delta])-filter' = (,) <$> identifier <*> (parens (commaSep1 term) <|> pure [])--collection :: Parser m => m (Exp Delta)-collection = ann (EVar <$> variable <|> ELit <$> col)- where- col =- Object <$> object- <|> Array <$> array- <|> String <$> stringLiteral--literal :: Parser m => m Value-literal =- Bool <$> bool- <|> Number <$> number- <|> String <$> stringLiteral- <|> Object <$> object- <|> Array <$> array--number :: Parser m => m Scientific-number = either fromIntegral fromFloatDigits <$> integerOrDouble--bool :: Parser m => m Bool-bool = symbol "true" *> return True <|> symbol "false" *> return False--object :: Parser m => m Object-object = Map.fromList <$> braces (commaSep pair)- where- pair =- (,)- <$> (stringLiteral <* spaces)- <*> (char ':' *> spaces *> literal)--array :: Parser m => m Array-array = Vector.fromList <$> brackets (commaSep literal)--operator :: Parser m => Text -> m Delta-operator n = position <* reserveText operatorStyle n--keyword :: Parser m => String -> m Delta-keyword k = position <* try (reserve keywordStyle k)--variable :: (Monad m, TokenParsing m) => m Var-variable = Var <$> (NonEmpty.fromList <$> sepBy1 identifier (char '.'))--identifier :: (Monad m, TokenParsing m) => m Id-identifier = ident variableStyle--spaces :: (Monad m, TokenParsing m) => m ()-spaces = skipMany (oneOf "\t ")--manyTill1 :: Alternative m => m a -> m b -> m [a]-manyTill1 p end = (:) <$> p <*> manyTill p end--manyEndBy1 :: Alternative m => m a -> m a -> m [a]-manyEndBy1 p end = go- where- go = (: []) <$> end <|> (:) <$> p <*> go--chainl1' :: Alternative m => m a -> m b -> m (a -> b -> a) -> m a-chainl1' l r op = scan- where- scan = flip id <$> l <*> rst- rst = (\f y g x -> g (f x y)) <$> op <*> r <*> rst <|> pure id--ann :: (DeltaParsing m, Functor f) => m (f (Mu f)) -> m (Cofree f Delta)-ann p = cofree <$> position <*> (Mu <$> p)--pack :: Functor f => f String -> f Value-pack = fmap (String . Text.pack)--triml :: Parser m => m a -> m a-triml p = do- c <- column <$> position- if c == 0- then spaces *> p- else fail "left whitespace removal failed"--trimr :: Parser m => m a -> m a-trimr p = p <* spaces <* newline--pragmak :: Parser m => String -> m ()-pragmak = reserve pragmaStyle--pragmal, pragmar :: Parser m => m String-pragmal = left delimPragma >>= symbol-pragmar = right delimPragma >>= string--commentl, commentr :: MonadState Env m => m String-commentl = left delimComment-commentr = right delimComment--inlinel, inliner :: Parser m => m String-inlinel = left delimInline >>= symbol-inliner = right delimInline >>= string--blockl, blockr :: Parser m => m String-blockl = left delimBlock >>= symbol-blockr = right delimBlock >>= string--left, right :: MonadState s m => Getter s Delim -> m String-left d = gets (fst . view d)-right d = gets (snd . view d)
− src/Text/EDE/Internal/Quoting.hs
@@ -1,213 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE ExtendedDefaultRules #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}---- Module : Text.EDE.Internal.Quoting--- 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)--module Text.EDE.Internal.Quoting where--import Control.Applicative-import Control.Monad-import Data.Aeson hiding (Result (..))-import qualified Data.Aeson as A-import Data.Bifunctor-import qualified Data.ByteString.Char8 as BS-import qualified Data.HashMap.Strict as Map-import Data.List (sortBy)-import Data.Ord (comparing)-import Data.Scientific-#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup-#endif-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import qualified Data.Text.Lazy as LText-import Data.Text.Lazy.Builder-import Data.Text.Manipulate (toOrdinal)-import Data.Text.Prettyprint.Doc (Pretty (..), (<+>))-import qualified Data.Text.Prettyprint.Doc as PP-import qualified Data.Vector as Vector-import Text.EDE.Internal.Types-import Text.Trifecta.Delta-import Text.Trifecta.Rendering--default (AnsiDoc, Double, Integer)---- | A HOAS representation of (possibly partially applied) values--- in the environment.-data Term- = TVal !Value- | TLam (Term -> Result Term)--instance AnsiPretty Term where- apretty = \case- TLam _ -> "Function"- TVal v -> bold (pp v)---- | Fully apply two 'Term's.-qapply :: Delta -> Term -> Term -> Result Term-qapply d a b = case (a, b) of- (TLam f, x) ->- case f x of- Failure e -> Failure (prettyDelta d <+> red "error:" <+> e)- Success y -> return y- (TVal x, _) ->- Failure $- "unable to apply literal"- <+> apretty a- <+> "->"- <+> apretty b- </> pp x---- | Quote a primitive 'Value' from the top-level.-qprim :: (ToJSON a, Quote a) => a -> Term-qprim = quote "Value" 0--class Unquote a where- unquote :: Id -> Int -> Term -> Result a- default unquote :: FromJSON a => Id -> Int -> Term -> Result a- unquote k n = \case- f@TLam {} -> typeErr k n (apretty f) "Value"- TVal v ->- case fromJSON v of- A.Success x -> pure x- A.Error e -> argumentErr k n e--instance Unquote Value--instance Unquote Text--instance Unquote [Text]--instance Unquote LText.Text--instance Unquote Bool--instance Unquote Double--instance Unquote Scientific--instance Unquote Object--instance Unquote Array--instance Unquote Int where- unquote k n =- unquote k n- >=> maybe (typeErr k n "Double" "Int") pure- . toBoundedInteger--instance Unquote Integer where- unquote k n =- unquote k n- >=> either (const (typeErr k n "Double" "Integral")) pure- . floatingOrInteger--instance Unquote Collection where- unquote k n q =- text <$> unquote k n q- <|> hashMap <$> unquote k n q- <|> vector <$> unquote k n q- where- text t =- Col (Text.length t)- . map (\c -> (Nothing, String (Text.singleton c)))- $ Text.unpack t-- hashMap m =- Col (Map.size m)- . map (first Just)- . sortBy (comparing fst)- $ Map.toList m-- vector v = Col (Vector.length v) (Vector.map (Nothing,) v)--class Quote a where- quote :: Id -> Int -> a -> Term- default quote :: ToJSON a => Id -> Int -> a -> Term- quote _ _ = TVal . toJSON--instance (Unquote a, Quote b) => Quote (a -> b) where- quote k n f = TLam $ \x -> quote k n' . f <$> unquote k n' x- where- n' = succ n--instance Quote Term where- quote _ _ = id--instance Quote Value--instance Quote [Value]--instance Quote Text--instance Quote [Text]--instance Quote LText.Text--instance Quote Bool--instance Quote Int--instance Quote Integer--instance Quote Double--instance Quote Scientific--instance Quote Object--instance Quote Array--instance Quote Builder where- quote k n = quote k n . toLazyText--typeErr :: Id -> Int -> AnsiDoc -> AnsiDoc -> Result a-typeErr k n x y = Failure $ "type" <+> pp k <+> pretty n <+> x <+> "::" <+> y--argumentErr :: Pretty a => Id -> Int -> a -> Result b-argumentErr k n e = Failure $ if self then app else arg- where- app =- "unable to apply"- <+> bold (pp k)- <+> "to left hand side:"- </> PP.indent 4 (pretty e </> prettyRendering mark)-- arg =- "invalid"- <+> bold (pp $ toOrdinal (n - 1))- <+> "argument to"- <+> bold (pp k)- <> ":"- </> PP.indent 4 (pretty e </> prettyRendering mark)-- mark =- renderingCaret (Columns col col) $- "... | " <> Text.encodeUtf8 k <> line-- col- | self = 1- | otherwise = fromIntegral (Text.length k + 4 + (n * 2))-- line- | self = "\n"- | otherwise =- "(" <> BS.intercalate ", " (replicate (n - 1) "...") <> "\n"-- self = n <= 1
− src/Text/EDE/Internal/Syntax.hs
@@ -1,113 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- Module : Text.EDE.Internal.Syntax--- 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)--module Text.EDE.Internal.Syntax where--import Control.Lens-import Data.HashSet (HashSet)-import qualified Data.HashSet as Set-import Text.EDE.Internal.Types-import Text.Parser.Token.Style-import Text.Trifecta---- | The default ED-E syntax.------ Delimiters:------ * Pragma: @{! ... !}@------ * Inline: @{{ ... }}@------ * Comments: @{# ... #}@------ * Blocks: @{% ... %}@-defaultSyntax :: Syntax-defaultSyntax =- Syntax- { _delimPragma = ("{!", "!}"),- _delimInline = ("{{", "}}"),- _delimComment = ("{#", "#}"),- _delimBlock = ("{%", "%}")- }---- | An alternate syntax (based on Play/Scala templates) designed to--- be used when the default is potentially ambiguous due to another encountered--- smarty based syntax.------ Delimiters:------ * Inline: @\<\@ ... \@>@------ * Comments: @\@* ... *\@@------ * Blocks: @\@( ... )\@@-alternateSyntax :: Syntax-alternateSyntax =- Syntax- { _delimPragma = ("@!", "!@"),- _delimInline = ("<@", "@>"),- _delimComment = ("@*", "*@"),- _delimBlock = ("@(", ")@")- }--commentStyle :: String -> String -> CommentStyle-commentStyle s e = emptyCommentStyle & commentStart .~ s & commentEnd .~ e--operatorStyle :: TokenParsing m => IdentifierStyle m-operatorStyle = haskellOps & styleLetter .~ oneOf "-+!&|=><"--variableStyle :: TokenParsing m => IdentifierStyle m-variableStyle = keywordStyle & styleName .~ "variable"--keywordStyle :: TokenParsing m => IdentifierStyle m-keywordStyle =- haskellIdents- & styleReserved .~ keywordSet- & styleName .~ "keyword"--keywordSet :: HashSet String-keywordSet =- Set.fromList- [ "if",- "elif",- "else",- "case",- "when",- "for",- "include",- "let",- "endif",- "endcase",- "endfor",- "endlet",- "in",- "with",- "_",- ".",- "true",- "false"- ]--pragmaStyle :: TokenParsing m => IdentifierStyle m-pragmaStyle =- haskellIdents- & styleReserved .~ pragmaSet- & styleName .~ "pragma field"--pragmaSet :: HashSet String-pragmaSet =- Set.fromList- [ "pragma",- "inline",- "comment",- "block"- ]
− src/Text/EDE/Internal/Types.hs
@@ -1,231 +0,0 @@-{-# LANGUAGE CPP #-}-{-# 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)--module Text.EDE.Internal.Types where--import Control.Applicative-import Control.Comonad-import Control.Comonad.Cofree-import Control.Lens-import Data.Aeson.Types hiding (Result (..))-import qualified Data.Functor.Classes as FunctorClasses-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--type AnsiDoc = Doc PP.AnsiStyle--class AnsiPretty a where- apretty :: a -> AnsiDoc---- | Convenience wrapper for Pretty instances.-newtype PP a = PP {unPP :: a}--pp :: AnsiPretty (PP a) => a -> AnsiDoc-pp = apretty . PP--(</>) :: Doc ann -> Doc ann -> Doc ann-x </> y = x <> PP.softline <> y--bold :: AnsiDoc -> AnsiDoc-bold = PP.annotate PP.bold--red :: AnsiDoc -> AnsiDoc-red = PP.annotate (PP.color PP.Red)--instance AnsiPretty (PP Text) where- apretty = pretty . Text.unpack . unPP--instance AnsiPretty (PP Value) where- apretty (PP v) =- case v of- Null -> "Null"- Bool _ -> "Bool"- Number _ -> "Scientific"- Object _ -> "Object"- Array _ -> "Array"- String _ -> "String"---- | The result of running parsing or rendering steps.-data Result a- = Success a- | Failure AnsiDoc- deriving (Show, Functor, Foldable, Traversable)--makePrisms ''Result--instance Monad Result where- return = Success- {-# INLINE return #-}- Success x >>= k = k x- Failure e >>= _ = Failure e- {-# INLINE (>>=) #-}--instance Applicative Result where- pure = return- {-# INLINE pure #-}- Success f <*> Success x = Success (f x)- Success _ <*> Failure e = Failure e- Failure e <*> Success _ = Failure e- Failure e <*> Failure e' = Failure (PP.vsep [e, e'])- {-# INLINE (<*>) #-}--instance Alternative Result where- Success x <|> Success _ = Success x- Success x <|> Failure _ = Success x- Failure _ <|> Success x = Success x- Failure e <|> Failure e' = Failure (PP.vsep [e, e'])- {-# INLINE (<|>) #-}- empty = Failure mempty- {-# INLINE empty #-}--instance Show a => AnsiPretty (Result a) where- apretty (Success x) = pretty (show x)- apretty (Failure e) = 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 (Left . show) 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 _ g (Success x) = g x-result f _ (Failure e) = f e---- | Convenience for returning a successful 'Result'.-success :: Monad m => a -> m (Result a)-success = return . Success---- | Convenience for returning an error 'Result'.-failure :: Monad m => AnsiDoc -> m (Result a)-failure = return . Failure--type Delim = (String, String)--data Syntax = Syntax- { _delimPragma :: !Delim,- _delimInline :: !Delim,- _delimComment :: !Delim,- _delimBlock :: !Delim- }--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- { _tmplName :: !Text,- _tmplExp :: !(Exp Delta),- _tmplIncl :: HashMap Id (Exp Delta)- }- deriving (Eq)--type Id = Text--newtype Var = Var (NonEmpty Id)- deriving (Eq)--instance AnsiPretty Var where- apretty (Var is) =- PP.hcat- . PP.punctuate "."- . map (PP.annotate PP.bold . pp)- . reverse- $ NonEmpty.toList is--instance Show Var where- show = show . apretty--data Collection where- Col :: Foldable f => Int -> f (Maybe Text, Value) -> Collection--data Pat- = PWild- | PVar !Var- | PLit !Value- deriving (Eq, 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 (Eq, Show, Functor)--instance FunctorClasses.Eq1 ExpF where- liftEq _ (ELit a) (ELit b) = a == b- liftEq _ (EVar a) (EVar b) = a == b- liftEq _ (EFun a) (EFun b) = a == b- liftEq c (EApp a1 a2) (EApp b1 b2) = a1 `c` b1 && a2 `c` b2- liftEq c (ELet a0 a1 a2) (ELet b0 b1 b2) = a0 == b0 && a1 `c` b1 && a2 `c` b2- liftEq c (ECase a as) (ECase b bs) = a `c` b && (List.all (uncurry altEq) $ zip as bs)- where- altEq (pA, a') (pB, b') = pA == pB && a' `c` b'- liftEq c (ELoop a0 a1 a2) (ELoop b0 b1 b2) = a0 == b0 && a1 `c` b1 && a2 `c` b2- liftEq _ (EIncl a) (EIncl b) = a == b- liftEq _ _ _ = False--type Exp = Cofree ExpF--instance HasDelta (Exp Delta) where- delta = extract---- | Unwrap a 'Value' to an 'Object' safely.------ See 'Aeson''s documentation for more details.-fromValue :: Value -> Maybe Object-fromValue (Object o) = Just o-fromValue _ = Nothing---- | Create an 'Object' from a list of name/value 'Pair's.------ See 'Aeson''s documentation for more details.-fromPairs :: [Pair] -> Object-fromPairs = (\(Object o) -> o) . object
test/Main.hs view
@@ -13,59 +13,66 @@ module Main (main) where import qualified Data.Aeson as Aeson-import Data.Bifunctor-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS-import Data.List (isSuffixOf)-import Data.Maybe+import qualified Data.Bifunctor as Bifunctor+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as ByteString.Lazy+import qualified Data.List as List+import qualified Data.Maybe as Maybe import qualified Data.Text as Text-import qualified Data.Text.Lazy.Encoding as LText-import Paths_ede-import System.Directory-import System.IO.Unsafe-import Test.Tasty-import Test.Tasty.Golden-import Text.EDE+import qualified Data.Text.Lazy.Encoding as Text.Lazy.Encoding+import qualified Paths_ede as Paths+import qualified System.Directory as Directory+import qualified System.IO.Unsafe as IO.Unsafe+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.Golden as Tasty.Golden+import qualified Text.EDE as EDE +-- FIXME: migrate to tasty's resource bracketing. main :: IO ()-main = defaultMain . testGroup "ED-E" $ unsafePerformIO tests+main =+ Tasty.defaultMain $+ Tasty.testGroup "ED-E" $+ IO.Unsafe.unsafePerformIO tests resources :: FilePath-resources = unsafePerformIO getDataDir+resources = IO.Unsafe.unsafePerformIO Paths.getDataDir -include :: Resolver IO-include = includeFile resources+include :: EDE.Resolver IO+include = EDE.includeFile resources -tests :: IO [TestTree]+tests :: IO [Tasty.TestTree] tests = files >>= mapM test where files :: IO [FilePath] files =- map (resources ++) . filter (isSuffixOf ".ede")- <$> getDirectoryContents resources+ map (resources ++) . filter (List.isSuffixOf ".ede")+ <$> Directory.getDirectoryContents resources - test :: FilePath -> IO TestTree+ test :: FilePath -> IO Tasty.TestTree test f = do (bs, n) <- (,)- <$> BS.readFile f- <*> pure (takeWhile (/= '.') f)+ <$> ByteString.readFile f+ <*> pure (List.takeWhile (/= '.') f) let (js, src) = split bs name = Text.pack (n ++ ".ede") - return . goldenVsStringDiff n diff (n ++ ".golden") $ do- r <- parseWith defaultSyntax include name src- result+ pure . Tasty.Golden.goldenVsStringDiff n diff (n ++ ".golden") $ do+ r <- EDE.parseWith EDE.defaultSyntax include name src++ EDE.result (error . show)- (return . LText.encodeUtf8)- (r >>= (`render` js))+ (pure . Text.Lazy.Encoding.encodeUtf8)+ (r >>= (`EDE.render` js)) diff r n = ["diff", "-u", r, n] - split = bimap input (BS.drop 4) . BS.breakSubstring "---"+ split =+ Bifunctor.bimap input (ByteString.drop 4)+ . ByteString.breakSubstring "---" input =- fromMaybe (error "Failed parsing JSON")+ Maybe.fromMaybe (error "Failed parsing JSON") . Aeson.decode'- . LBS.fromStrict+ . ByteString.Lazy.fromStrict