ede (empty) → 0.2.1
raw patch · 13 files changed
+2686/−0 lines, 13 filesdep +aesondep +ansi-wl-pprintdep +basesetup-changed
Dependencies added: aeson, ansi-wl-pprint, base, bifunctors, bytestring, conduit, conduit-extra, directory, ede, filepath, lens, mtl, optparse-applicative, parsers, scientific, semigroups, tasty, tasty-golden, text, text-format, text-manipulate, trifecta, unordered-containers, vector
Files
- LICENSE +373/−0
- README.md +37/−0
- Setup.hs +2/−0
- ede.cabal +126/−0
- src/Main.hs +98/−0
- src/Text/EDE.hs +661/−0
- src/Text/EDE/Filters.hs +258/−0
- src/Text/EDE/Internal/Eval.hs +193/−0
- src/Text/EDE/Internal/HOAS.hs +191/−0
- src/Text/EDE/Internal/Parser.hs +360/−0
- src/Text/EDE/Internal/Syntax.hs +110/−0
- src/Text/EDE/Internal/Types.hs +210/−0
- test/Main.hs +67/−0
+ LICENSE view
@@ -0,0 +1,373 @@+Mozilla Public License Version 2.0+==================================++1. Definitions+--------------++1.1. "Contributor"+ means each individual or legal entity that creates, contributes to+ the creation of, or owns Covered Software.++1.2. "Contributor Version"+ means the combination of the Contributions of others (if any) used+ by a Contributor and that particular Contributor's Contribution.++1.3. "Contribution"+ means Covered Software of a particular Contributor.++1.4. "Covered Software"+ means Source Code Form to which the initial Contributor has attached+ the notice in Exhibit A, the Executable Form of such Source Code+ Form, and Modifications of such Source Code Form, in each case+ including portions thereof.++1.5. "Incompatible With Secondary Licenses"+ means++ (a) that the initial Contributor has attached the notice described+ in Exhibit B to the Covered Software; or++ (b) that the Covered Software was made available under the terms of+ version 1.1 or earlier of the License, but not also under the+ terms of a Secondary License.++1.6. "Executable Form"+ means any form of the work other than Source Code Form.++1.7. "Larger Work"+ means a work that combines Covered Software with other material, in+ a separate file or files, that is not Covered Software.++1.8. "License"+ means this document.++1.9. "Licensable"+ means having the right to grant, to the maximum extent possible,+ whether at the time of the initial grant or subsequently, any and+ all of the rights conveyed by this License.++1.10. "Modifications"+ means any of the following:++ (a) any file in Source Code Form that results from an addition to,+ deletion from, or modification of the contents of Covered+ Software; or++ (b) any new file in Source Code Form that contains any Covered+ Software.++1.11. "Patent Claims" of a Contributor+ means any patent claim(s), including without limitation, method,+ process, and apparatus claims, in any patent Licensable by such+ Contributor that would be infringed, but for the grant of the+ License, by the making, using, selling, offering for sale, having+ made, import, or transfer of either its Contributions or its+ Contributor Version.++1.12. "Secondary License"+ means either the GNU General Public License, Version 2.0, the GNU+ Lesser General Public License, Version 2.1, the GNU Affero General+ Public License, Version 3.0, or any later versions of those+ licenses.++1.13. "Source Code Form"+ means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+ means an individual or a legal entity exercising rights under this+ License. For legal entities, "You" includes any entity that+ controls, is controlled by, or is under common control with You. For+ purposes of this definition, "control" means (a) the power, direct+ or indirect, to cause the direction or management of such entity,+ whether by contract or otherwise, or (b) ownership of more than+ fifty percent (50%) of the outstanding shares or beneficial+ ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+ Licensable by such Contributor to use, reproduce, make available,+ modify, display, perform, distribute, and otherwise exploit its+ Contributions, either on an unmodified basis, with Modifications, or+ as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+ for sale, have made, import, and otherwise transfer either its+ Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+ or++(b) for infringements caused by: (i) Your and any other third party's+ modifications of Covered Software, or (ii) the combination of its+ Contributions with other software (except as part of its Contributor+ Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+ its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+ Form, as described in Section 3.1, and You must inform recipients of+ the Executable Form how they can obtain a copy of such Source Code+ Form by reasonable means in a timely manner, at a charge no more+ than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+ License, or sublicense it under different terms, provided that the+ license for the Executable Form does not attempt to limit or alter+ the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+* *+* 6. Disclaimer of Warranty *+* ------------------------- *+* *+* Covered Software is provided under this License on an "as is" *+* basis, without warranty of any kind, either expressed, implied, or *+* statutory, including, without limitation, warranties that the *+* Covered Software is free of defects, merchantable, fit for a *+* particular purpose or non-infringing. The entire risk as to the *+* quality and performance of the Covered Software is with You. *+* Should any Covered Software prove defective in any respect, You *+* (not any Contributor) assume the cost of any necessary servicing, *+* repair, or correction. This disclaimer of warranty constitutes an *+* essential part of this License. No use of any Covered Software is *+* authorized under this License except under this disclaimer. *+* *+************************************************************************++************************************************************************+* *+* 7. Limitation of Liability *+* -------------------------- *+* *+* Under no circumstances and under no legal theory, whether tort *+* (including negligence), contract, or otherwise, shall any *+* Contributor, or anyone who distributes Covered Software as *+* permitted above, be liable to You for any direct, indirect, *+* special, incidental, or consequential damages of any character *+* including, without limitation, damages for lost profits, loss of *+* goodwill, work stoppage, computer failure or malfunction, or any *+* and all other commercial damages or losses, even if such party *+* shall have been informed of the possibility of such damages. This *+* limitation of liability shall not apply to liability for death or *+* personal injury resulting from such party's negligence to the *+* extent applicable law prohibits such limitation. Some *+* jurisdictions do not allow the exclusion or limitation of *+* incidental or consequential damages, so this exclusion and *+* limitation may not apply to You. *+* *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++ This Source Code Form is subject to the terms of the Mozilla Public+ License, v. 2.0. If a copy of the MPL was not distributed with this+ file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++ This Source Code Form is "Incompatible With Secondary Licenses", as+ defined by the Mozilla Public License, v. 2.0.
+ README.md view
@@ -0,0 +1,37 @@+# ED-E++* [Introduction](#introduction)+* [Syntax](#syntax)+* [Contribute](#contribute)+* [Licence](#licence)+++## Introduction++ED-E is a templating language written in Haskell with a specific set of features:++* **Logicless (within reason):** A small set of consistent predicates and expressions for formatting and presentational logic are provided.+* **Secure:** No arbitrary code evaluation, with input data required to be fully specified at render time.+* **Stateless:** Parsing and rendering are separate steps so that loading, parsing, include resolution, and embedding of the compiled template can optionally be done ahead of time, amortising cost.+* **Markup agnostic:** ED-E is used to write out everything from configuration files for system services, to HTML and formatted emails.+* **Control over purity:** Users can choose pure or IO-based resolution of `include` expressions.+* **No surprises:** All parsing, type assurances, and rendering steps report helpful error messages with line/column metadata. Variable shadowing, unprintable expressions, implicit type coercion, and unbound variable access are all treated as errors errors.++Please see the [documentation](http://brendanhay.github.io/ede/Text-EDE.html)+for more information.+++## Syntax++A set of syntatic/semantic fragments for all supported expressions can be+found in the [tests](test/resources) or the [documentation](http://brendanhay.github.io/ede/Text-EDE.html#syntax).+++## Contribute++For any problems, comments or feedback please create an issue [here on GitHub](github.com/brendanhay/ede/issues).+++## Licence++ED-E is released under the [Mozilla Public License Version 2.0](http://www.mozilla.org/MPL/)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ede.cabal view
@@ -0,0 +1,126 @@+name: ede+version: 0.2.1+synopsis: Templating language with similar syntax and features to Liquid or Jinja2.+homepage: http://github.com/brendanhay/ede+license: OtherLicense+license-file: LICENSE+author: Brendan Hay+maintainer: Brendan Hay <brendan.g.hay@gmail.com>+copyright: Copyright (c) 2013-2014 Brendan Hay+stability: Experimental+category: Text, Template, Web+build-type: Simple+cabal-version: >= 1.10++description:+ ED-E is a templating language written in Haskell with a specific set of features:+ .+ * Logicless within reason. A small set of consistent predicates+ and expressions for formatting and presentational logic are provided.+ .+ * Secure. No arbitrary code evaluation, with input data required to be fully specified+ at render time.+ .+ * Stateless. Parsing and rendering are separate steps so that loading, parsing,+ include resolution, and embedding of the compiled template can optionally be+ done ahead of time, amortising cost.+ .+ * Markup agnostic. ED-E is used to write out everything from configuration files for+ system services, to HTML and formatted emails.+ .+ * Control over purity. Users can choose pure or IO-based resolution of+ @include@ expressions.+ .+ * No surprises. All parsing, type assurances, and rendering steps report helpful+ error messages with line/column metadata. Variable shadowing, unprintable expressions,+ implicit type coercion, and unbound variable access are all treated as errors.++extra-source-files:+ README.md++source-repository head+ type: git+ location: git://github.com/brendanhay/ede.git++flag build-executable+ description: Whether to build the ed-e executable.+ default: False+ manual: True++library+ default-language: Haskell2010+ hs-source-dirs: src++ exposed-modules:+ Text.EDE+ , Text.EDE.Filters++ other-modules:+ Text.EDE.Internal.Eval+ , Text.EDE.Internal.HOAS+ , Text.EDE.Internal.Parser+ , Text.EDE.Internal.Syntax+ , Text.EDE.Internal.Types++ , Paths_ede++ ghc-options: -Wall++ build-depends:+ aeson >= 0.7+ , ansi-wl-pprint >= 0.6.6+ , base >= 4.6 && < 5+ , bifunctors >= 4+ , bytestring >= 0.9+ , directory >= 1.2+ , filepath >= 1.2+ , lens >= 4.0+ , mtl >= 2.2+ , parsers >= 0.12.1.1+ , scientific >= 0.3.1+ , semigroups >= 0.15+ , text >= 1.2 && < 1.3+ , text-format >= 0.3+ , text-manipulate >= 0.1+ , trifecta >= 1.5.1+ , unordered-containers >= 0.2.3+ , vector >= 0.7.1++executable ed-e+ default-language: Haskell2010+ main-is: src/Main.hs++ ghc-options: -Wall -rtsopts "-with-rtsopts=-T -I0"++ if !flag(build-executable)+ buildable: False+ else+ build-depends:+ aeson+ , base >= 4.6 && < 5+ , bytestring+ , conduit == 1.2.*+ , conduit-extra == 1.1.*+ , directory+ , ede+ , optparse-applicative == 0.11.*+ , text++test-suite golden+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs++ ghc-options: -Wall -threaded++ build-depends:+ aeson+ , base >= 4.6 && < 5+ , bifunctors+ , bytestring+ , directory+ , ede+ , text+ , tasty+ , tasty-golden
+ src/Main.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE RecordWildCards #-}++-- Module : Text.EDE+-- Copyright : (c) 2013-2014 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 Main (main) where++import Control.Monad+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Conduit+import qualified Data.Conduit.Attoparsec as Conduit+import qualified Data.Conduit.Binary as Conduit+import Data.Monoid+import qualified Data.Text.Lazy.IO as Text+import Data.Version (showVersion)+import Options.Applicative+import qualified System.Directory as Dir+import qualified System.IO as IO+import qualified Text.EDE as EDE++data Options = Options+ { template :: FilePath+ , bindings :: Maybe Object+ , alternate :: !Bool+ } deriving (Eq, Show)++optionParser :: Parser Options+optionParser = Options+ <$> (strOption+ ( short 't'+ <> long "template"+ <> metavar "FILE"+ <> help "ED-E template to render."+ )+ <|> argument str (metavar "FILE"))++ <*> optional (option (eitherReader reader)+ ( short 'd'+ <> long "data"+ <> metavar "JSON"+ <> help ("Bindings to make available in the environment, as JSON. \+ \If not given, standard input is read.")+ ))++ <*> switch+ ( short 'a'+ <> long "alternate-syntax"+ <> help "Use alternate template syntax."+ )++optionInfo :: ParserInfo Options+optionInfo = info (helper <*> optionParser)+ ( fullDesc+ <> header ("ed-e v" ++ showVersion EDE.version)+ <> progDesc "ED-E Template Engine CLI."+ )++main :: IO ()+main = execParser optionInfo >>= render+ where+ render Options{..} = do+ t <- parse template alternate+ b <- maybe stdin return bindings+ EDE.result errRender Text.putStrLn (EDE.render t b)++ parse f alt = do+ p <- Dir.getPermissions f+ unless (Dir.readable p) (errUnreadable f)++ let syntax | alt = EDE.alternateSyntax+ | otherwise = EDE.defaultSyntax++ EDE.parseFileWith syntax f >>=+ EDE.result (error . show) return++ stdin = do+ IO.hSetBinaryMode IO.stdin True+ v <- Conduit.sourceHandle IO.stdin $$ Conduit.sinkParser json'+ either (error . show) return (fromValue v)++ errRender = error . mappend "Error rendering template:\n" . show++ errUnreadable = error . (<> " is not readable")++reader :: String -> Either String Object+reader = join . fmap fromValue . eitherDecode . LBS.pack++fromValue :: Value -> Either String Object+fromValue = maybe (Left "Bindings must be given as a JSON object") Right+ . EDE.fromValue
+ src/Text/EDE.hs view
@@ -0,0 +1,661 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}++-- Module : Text.EDE+-- Copyright : (c) 2013-2014 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+ , includeMap+ , includeFile++ -- ** Filters+ , defaultFilters++ -- ** 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(..))+import Data.Monoid+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.Version (Version)+import qualified Paths_ede as Paths+import System.Directory+import System.FilePath+import Text.EDE.Filters+import qualified Text.EDE.Internal.Eval as Eval+import qualified Text.EDE.Internal.Parser as Parser+import Text.EDE.Internal.Syntax+import Text.EDE.Internal.Types+import Text.PrettyPrint.ANSI.Leijen (string)+import Text.Trifecta.Delta++-- FIXME: detect include/import loops+-- FIXME: {%- tags to deliberately strip/trim whitespace+-- FIXME: ... {% include %} inline adds a trailing newline+-- FIXME: streaming io+-- FIXME: add benchmarks+-- FIXME: add capture+-- FIXME: numerous 'try' calls were added during development, these should now be reduced.++-- | 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 :: ByteString -- ^ Strict 'ByteString' template definition.+ -> 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 :: FilePath -- ^ Parent directory for relatively pathed includes.+ -> ByteString -- ^ Strict 'ByteString' template definition.+ -> 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 :: FilePath -- ^ Path to the template to load and parse.+ -> IO (Result Template)+parseFile = parseFileWith defaultSyntax++-- | /See:/ 'parseFile'.+parseFileWith :: Syntax -- ^ Delimiters and parsing options.+ -> FilePath -- ^ Path to the template to load and parse.+ -> 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+ => Syntax -- ^ Delimiters and parsing options.+ -> Resolver m -- ^ Function to resolve includes.+ -> Text -- ^ Strict 'Text' name.+ -> ByteString -- ^ Strict 'ByteString' template definition.+ -> 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+ => HashMap Text Template -- ^ A 'HashMap' of named 'Template's.+ -> Resolver m -- ^ Resolver for 'parseWith'.+includeMap ts _ k _+ | Just v <- Map.lookup k ts = success v+ | otherwise = failure ("unable to resolve " <> string (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 :: FilePath -- ^ Parent directory for relatively pathed includes.+ -> 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 " <> string p <> " doesn't exist.")+ else BS.readFile p >>= success++-- | Render an 'Object' using the supplied 'Template'.+render :: Template -- ^ Parsed 'Template' to render.+ -> Object -- ^ Bindings to make available in the environment.+ -> Result LText.Text+render = renderWith defaultFilters++-- | Render an 'Object' using the supplied 'Template'.+renderWith :: HashMap Text Binding -- ^ Filters to make available in the environment.+ -> Template -- ^ Parsed 'Template' to render.+ -> Object -- ^ Bindings to make available in the environment.+ -> 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 Text Binding+ -> 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:+--+-- >>> let tmpl = "{% if var %}\nHello, {{ var }}!\n{% else %}\nnegative!\n{% endif %}\n" :: Data.ByteString.ByteString+--+-- 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 'Value' constructor, exposing the delicious 'HashMap' underneath.+--+-- Finally the environment is applied to the 'Template':+--+-- >>> 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 singuarly 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 }}+-- > ...
+ src/Text/EDE/Filters.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Text.EDE.Filters+-- Copyright : (c) 2013-2014 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 default set of prelude-like filters and the means to construct your own.+--+-- Please be aware that some of the 'defaultFilters' are assumed to be present+-- (for example during loop unrolling and assignment of else branches via 'empty').+--+-- It's recommended you supplement the default filters rather than replacing them+-- completely. (But hey, it's your call!)+module Text.EDE.Filters+ (+ -- * Prelude+ defaultFilters++ -- ** Boolean+ -- $boolean++ -- ** Equality+ -- $equality++ -- ** Relational+ -- $relational++ -- ** Numeric+ -- $numeric++ -- ** Fractional+ -- $fractional++ -- ** Textual+ -- $textual++ -- ** Collection+ -- $collection++ -- ** Polymorphic+ -- $polymorphic++ -- * Constructing filters+ , Binding (..)++ -- ** Classes+ , Quote (..)+ , Unquote (..)++ -- ** Restricted quoters+ , qapply+ , qpoly2+ , qnum1+ , qnum2+ , qcol1++ -- ** Errors+ , unexpected+ , typeOf+ ) where++import Data.Aeson (Value, encode)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as Map+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 qualified Data.Vector as Vector+import Text.EDE.Internal.HOAS++default (Integer)++defaultFilters :: HashMap Text Binding+defaultFilters = Map.unions+ [ boolean+ , equality+ , relational+ , numeric+ , fractional+ , textual+ , collection+ , polymorphic+ ]++-- $boolean+--+-- * @!@ @:: Bool -> Bool@ (/See:/ 'not')+--+-- * '&&' @:: Bool -> Bool -> Bool@+--+-- * '||' @:: Bool -> Bool -> Bool@++boolean :: HashMap Text Binding+boolean = Map.fromList+ [ "!" @: quote not+ , "&&" @: quote (&&)+ , "||" @: quote (||)+ ]++-- $equality+--+-- * '==' @:: a -> a -> Bool@+--+-- * @!=@ @:: a -> a -> Bool@ (/See/: '/=')++equality :: HashMap Text Binding+equality = Map.fromList+ [ "==" @: qpoly2 (==)+ , "!=" @: qpoly2 (/=)+ ]++-- $relational+--+-- * '>' @:: a -> a -> Bool@+--+-- * '>=' @:: a -> a -> Bool@+--+-- * '<=' @:: a -> a -> Bool@+--+-- * '<=' @:: a -> a -> Bool@++relational :: HashMap Text Binding+relational = Map.fromList+ [ ">" @: qnum2 (>)+ , ">=" @: qnum2 (>=)+ , "<=" @: qnum2 (<=)+ , "<" @: qnum2 (<)+ ]++-- $numeric+--+-- * '+' @:: Number -> Number -> Number@+--+-- * '-' @:: Number -> Number -> Number@+--+-- * '*' @:: Number -> Number -> Number@+--+-- * 'abs' @:: Number -> Number@+--+-- * 'signum' @:: Number -> Number@+--+-- * 'negate' @:: Number -> Number@++numeric :: HashMap Text Binding+numeric = Map.fromList+ [ "+" @: qnum2 (+)+ , "-" @: qnum2 (-)+ , "*" @: qnum2 (*)+ , "abs" @: qnum1 abs+ , "signum" @: qnum1 signum+ , "negate" @: qnum1 negate+ ]++-- $fractional+--+-- * 'truncate' @:: Number -> Number@+--+-- * 'round' @:: Number -> Number@+--+-- * 'ceiling' @:: Number -> Number@+--+-- * 'floor' @:: Number -> Number@++fractional :: HashMap Text Binding+fractional = Map.fromList+ [ "truncate" @: qnum1 (fromIntegral . truncate)+ , "round" @: qnum1 (fromIntegral . round)+ , "ceiling" @: qnum1 (fromIntegral . ceiling)+ , "floor" @: qnum1 (fromIntegral . floor)+ ]++-- $textual+--+-- * @takeWord@ @:: Text -> Text@+--+-- * @dropWord@ @:: Text -> Text@+--+-- * @lowerHead@ @:: Text -> Text@+--+-- * @upperHead@ @:: Text -> Text@+--+-- * @toTitle@ @:: Text -> Text@+--+-- * @toCamel@ @:: Text -> Text@+--+-- * @toPascal@ @:: Text -> Text@+--+-- * @toSnake@ @:: Text -> Text@+--+-- * @toSpinal@ @:: Text -> Text@+--+-- * @toTrain@ @:: Text -> Text@+--+-- * @toLower@ @:: Text -> Text@+--+-- * @toUpper@ @:: Text -> Text@+--+-- * @toOrdinal@ @:: Number -> Text@+--+-- /See:/ <http://hackage.haskell.org/package/text-manipulate text-manipulate>++textual :: HashMap Text Binding+textual = Map.fromList+ [ "takeWord" @: quote takeWord+ , "dropWord" @: quote dropWord+ , "lowerHead" @: quote lowerHead+ , "upperHead" @: quote upperHead+ , "toTitle" @: quote toTitle+ , "toCamel" @: quote toCamel+ , "toPascal" @: quote toPascal+ , "toSnake" @: quote toSnake+ , "toSpinal" @: quote toSpinal+ , "toTrain" @: quote toTrain+ , "toUpper" @: quote Text.toUpper+ , "toLower" @: quote Text.toLower+ , "toOrdinal" @: (toOrdinal . truncate :: Scientific -> Text)+ ]++-- $collection+--+-- * @length@ @:: Collection -> Number@ (/See/: 'Data.Text.length', 'Data.Vector.length', 'Data.HashMap.Strict.size')+--+-- * @empty@ @:: Collection -> Bool@ (/See/: 'Data.Text.null', 'Data.Vector.null', 'Data.HashMap.Strict.null')++collection :: HashMap Text Binding+collection = Map.fromList+ [ "length" @: qcol1 Text.length Map.size Vector.length+ , "empty" @: qcol1 Text.null Map.null Vector.null+ -- , ("join", quote+ ]++-- $polymorphic+--+-- * 'show' @:: a -> Text@++polymorphic :: HashMap Text Binding+polymorphic = Map.fromList+ [ "show" @: quote value+ ]++(@:) :: Quote a => Text -> a -> (Text, Binding)+k @: q = (k, quote q)++value :: Value -> LText.Text+value = LText.decodeUtf8 . encode
+ src/Text/EDE/Internal/Eval.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++-- Module : Text.EDE.Internal.Eval+-- Copyright : (c) 2013-2014 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.Applicative+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 qualified Data.List.NonEmpty as NonEmpty+import Data.Monoid+import Data.Scientific (base10Exponent)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Buildable as Build+import Data.Text.Format (Format)+import Data.Text.Format.Params (Params)+import Data.Text.Lazy.Builder (Builder)+import Data.Text.Lazy.Builder.Scientific+import Text.EDE.Internal.HOAS+import Text.EDE.Internal.Types+import Text.Trifecta.Delta++-- FIXME: add pretty printer formatted error messages++data Env = Env+ { _templates :: HashMap Text Exp+ , _quoted :: HashMap Text Binding+ , _values :: HashMap Text Value+ }++type Context = ReaderT Env Result++render :: HashMap Text Exp+ -> HashMap Text Binding+ -> Exp+ -> HashMap Text Value+ -> Result Builder+render ts fs e o = runReaderT (eval e >>= nf) (Env ts fs o)+ where+ nf (BVal v) = build (delta e) v+ nf _ = lift $ Failure+ "unable to evaluate partially applied template to normal form."++eval :: Exp -> Context Binding+eval (ELit _ l) = return (quote l)+eval (EVar _ v) = quote <$> variable v+eval (EFun d i) = do+ q <- Map.lookup i <$> asks _quoted+ maybe (throwError' d "binding {} doesn't exist." [i])+ return+ q++eval (EApp d 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 q)+ bind (Map.insert k v) (eval bdy)++-- FIXME: We have to recompute c everytime due to the predicate ..+eval (ECase d p ws) = go ws+ where+ go [] = return (quote (String mempty))+ go ((a, e):as) =+ case a of+ PWild -> eval e+ PVar v -> eval (EVar d v) >>= cond e as+ PLit l -> eval (ELit d l) >>= cond e as++ cond e as y@(BVal Bool{}) = do+ x <- predicate p+ if x == y then eval e else go as+ cond e as y@BVal{} = do+ x <- eval p+ if x == y then eval e else go as+ cond _ as _ = go as++eval (ELoop _ i v bdy) = eval v >>= lift . unquote >>= loop+ where+ d = delta bdy++ loop :: Collection -> Context Binding+ loop (Col l xs) = snd <$> foldlM iter (1, quote (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 ())+ (\x -> throwError' d "binding {} shadows variable {} :: {}, {}"+ [Text.unpack i, show x, typeOf x, show n])+ (Map.lookup i m)++ 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 (EIncl d i) = do+ ts <- asks _templates+ case Map.lookup i ts of+ Just e -> eval e+ Nothing -> throwError' d "template {} is not in scope: [{}]"+ [i, Text.intercalate "," $ Map.keys ts]++bind :: (Object -> Object) -> Context a -> Context a+bind f = withReaderT (\x -> x { _values = f (_values x) })++variable :: Var -> Context Value+variable (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' undefined "binding {} doesn't exist." [fmt (k:r)])+ (go ks (k:r))+ (Map.lookup k m)+ where+ nest :: Value -> Context Object+ nest (Object o) = return o+ nest x =+ throwError' undefined "variable {} :: {} doesn't supported nested accessors."+ [fmt (k:r), typeOf x]++ fmt = Text.unpack . Text.intercalate "."++-- | A variable can be tested for truthiness, but a non-whnf expr cannot.+predicate :: Exp -> Context Binding+predicate x = do+ r <- runReaderT (eval x) <$> ask+ lift $ case r of+ Success q+ | BVal Bool{} <- q -> Success q+ Success q+ | BVal Null <- q -> Success (quote False)+ Success _ -> Success (quote True)+ Failure _+ | EVar{} <- x -> Success (quote False)+ Failure e -> Failure e++binding :: Delta -> Binding -> Binding -> Context Binding+binding d x y =+ case (x, y) of+ (BVal l, BVal r) -> quote <$> liftM2 (<>) (build d l) (build d r)+ _ -> lift (qapply x y)++build :: Delta -> Value -> Context Builder+build _ Null = return mempty+build _ (String t) = return (Build.build t)+build _ (Bool True) = return "true"+build _ (Bool False) = return "false"+build _ (Number n)+ | base10Exponent n == 0 = return (formatScientificBuilder Fixed (Just 0) n)+ | otherwise = return (scientificBuilder n)+build d x =+ throwError' d "unable to render literal {}\n{}" [typeOf x, show x]++-- FIXME: Add delta information to the thrown error document.+throwError' :: Params ps => Delta -> Format -> ps -> Context a+throwError' _ f = lift . throwError f
+ src/Text/EDE/Internal/HOAS.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++-- Module : Text.EDE.Internal.HOAS+-- Copyright : (c) 2013-2014 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.HOAS where++import Control.Applicative+import Control.Monad+import Data.Aeson hiding (Result(..))+import Data.Bifunctor+import qualified Data.HashMap.Strict as Map+import Data.List (sortBy)+import Data.Ord (comparing)+import Data.Scientific+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LText+import Data.Text.Lazy.Builder+import qualified Data.Vector as Vector+import Text.EDE.Internal.Types++-- | A HOAS representation of (possibly partially applied) values+-- in the environment.+data Binding+ = BVal !Value+ | BLam (Binding -> Result Binding)++instance Show Binding where+ show (BVal v) = show v+ show _ = "<function>"++instance Eq Binding where+ BVal a == BVal b = a == b+ _ == _ = False++-- | Retrieve a consistent type from a 'Value' to use in error messages.+typeOf :: Value -> String+typeOf = \case+ Null -> "Null"+ Bool _ -> "Bool"+ Number _ -> "Number"+ Object _ -> "Object"+ Array _ -> "Array"+ String _ -> "String"++-- | The default type for partially applied 'Binding's in error messages.+typeFun :: String+typeFun = "Function"++-- | Attempt to apply two 'Binding's.+qapply :: Binding -> Binding -> Result Binding+qapply a b = case (a, b) of+ (BLam f, x) -> f x+ (BVal x, _) -> throwError "unable to apply literal {} -> {}\n{}"+ [typeOf x, typeFun, show x]++-- | Quote a binary function which takes the most general binding value.+qpoly2 :: Quote a => (Value -> Value -> a) -> Binding+qpoly2 = quote++-- | Quote an unary numeric function.+qnum1 :: (Scientific -> Scientific) -> Binding+qnum1 = quote++-- | Quote a binary numeric function.+qnum2 :: Quote a => (Scientific -> Scientific -> a) -> Binding+qnum2 = quote++-- | Quote a comprehensive set of unary functions to create a binding+-- that supports all collection types.+qcol1 :: Quote a => (Text -> a) -> (Object -> a) -> (Array -> a) -> Binding+qcol1 f g h = BLam $ \case+ BVal (String t) -> pure . quote $ f t+ BVal (Object o) -> pure . quote $ g o+ BVal (Array v) -> pure . quote $ h v+ BVal y -> err (typeOf y)+ _ -> err typeFun+ where+ err = throwError "expected a String, Object, or Array, but got {}" . (:[])++class Quote a where+ quote :: a -> Binding++instance Quote Binding where+ quote = id++instance Quote Value where+ quote = BVal++instance Quote Text where+ quote = BVal . String++instance Quote LText.Text where+ quote = quote . LText.toStrict++instance Quote Builder where+ quote = quote . toLazyText++instance Quote Bool where+ quote = BVal . Bool++instance Quote Int where+ quote = BVal . Number . fromIntegral++instance Quote Integer where+ quote = BVal . Number . fromInteger++instance Quote Double where+ quote = BVal . Number . fromFloatDigits++instance Quote Scientific where+ quote = BVal . Number++instance Quote Object where+ quote = BVal . Object++instance Quote Array where+ quote = BVal . Array++class Unquote a where+ unquote :: Binding -> Result a++instance Unquote Value where+ unquote = \case+ BVal v -> pure v+ _ -> unexpected typeFun "Literal"++instance Unquote Text where+ unquote = unquote >=> \case+ String t -> pure t+ v -> unexpected (typeOf v) "String"++instance Unquote LText.Text where+ unquote = fmap LText.fromStrict . unquote++instance Unquote Bool where+ unquote = unquote >=> \case+ Bool b -> pure b+ v -> unexpected (typeOf v) "Bool"++instance Unquote Scientific where+ unquote = \case+ BVal (Number n) -> pure n+ BVal v -> unexpected (typeOf v) "Number"+ _ -> unexpected typeFun "Number"++instance Unquote Collection where+ unquote q = text <$> unquote q+ <|> hashMap <$> unquote q+ <|> vector <$> unquote 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)++instance Unquote Object where+ unquote = \case+ BVal (Object o) -> pure o+ BVal v -> unexpected (typeOf v) "Object"+ _ -> unexpected typeFun "Object"++instance Unquote Array where+ unquote = \case+ BVal (Array a) -> pure a+ BVal v -> unexpected (typeOf v) "Array"+ _ -> unexpected typeFun "Array"++instance (Unquote a, Quote b) => Quote (a -> b) where+ quote f = BLam (fmap (quote . f) . unquote)++unexpected :: String -> String -> Result b+unexpected x y = throwError "unable to coerce {} -> {}" [x, y]
+ src/Text/EDE/Internal/Parser.hs view
@@ -0,0 +1,360 @@+{-# LANGUAGE BangPatterns #-}+{-# 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-2014 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.Lens hiding (both, noneOf)+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.Semigroup+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.Syntax+import Text.EDE.Internal.Types+import Text.Parser.Expression+import Text.Parser.LookAhead+import Text.Parser.Token.Style (buildSomeSpaceParser)+import qualified Text.Trifecta as Tri+import Text.Trifecta hiding (Parser, Result(..), spaces)+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+ , MonadState Env m+ , TokenParsing m+ , DeltaParsing m+ , LookAheadParsing m+ , Errable m+ )++newtype EDE a = EDE { runEDE :: Tri.Parser a }+ deriving+ ( Functor+ , Applicative+ , Alternative+ , Monad+ , 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, 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 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+document = eapp <$> position <*> many (statement <|> inline <|> fragment)++inline :: Parser m => m Exp+inline = between inlinel inliner term++fragment :: Parser m => m Exp+fragment = ELit <$> position <*> 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+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+ifelif = eif+ <$> branch "if"+ <*> many (branch "elif")+ <*> else'+ <* exit "endif"+ where+ branch k = (,) <$> block k term <*> document++cases :: Parser m => m Exp+cases = ecase+ <$> block "case" term+ <*> many+ ((,) <$> block "when" pattern+ <*> document)+ <*> else'+ <* exit "endcase"++loop :: Parser m => m Exp+loop = do+ d <- position+ (i, v) <- block "for"+ ((,) <$> identifier+ <*> (keyword "in" *> collection))+ eempty d v+ <$> (ELoop d i v <$> document)+ <*> else'+ <* exit "endfor"++include :: Parser m => m Exp+include = do+ d <- position+ block "include" (incl d)+ where+ incl d = do+ k <- stringLiteral+ includes %= Map.insertWith (<>) k (d:|[])+ elet d (EIncl d k) <$> scope++ scope = optional $+ (,) <$> (keyword "with" *> identifier)+ <*> (symbol "=" *> term)++binding :: Parser m => m Exp+binding = do+ d <- position+ uncurry (ELet d)+ <$> block "let"+ ((,) <$> identifier+ <*> (symbol "=" *> term))+ <*> document+ <* exit "endlet"++raw :: Parser m => m Exp+raw = ELit+ <$> position+ <*> (start *> pack (manyTill anyChar (lookAhead end)) <* end)+ where+ 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+comment = ELit+ <$> position+ <*> pure (String mempty)+ <* (try (triml (trimr go)) <|> go)+ where+ go = (commentStyle <$> commentl <*> commentr) >>=+ buildSomeSpaceParser (fail "whitespace significant")++else' :: Parser m => m (Maybe Exp)+else' = optional (block "else" (pure ()) *> document)++exit :: Parser m => String -> m ()+exit k = block k (pure ())++term :: Parser m => m Exp+term = buildExpressionParser table expr+ where+ table =+ [ [prefix "!"]+ , [infix' "*", infix' "/"]+ , [infix' "-", infix' "+"]+ , [infix' "==", infix' "!=", infix' ">", infix' ">=", infix' "<", infix' "<="]+ , [infix' "&&"]+ , [infix' "||"]+ , [filter' "|"]+ ]++ prefix n = Prefix (efun <$> operator n <*> pure n)++ infix' n = Infix (do+ d <- operator n+ return $ \l r ->+ EApp d (efun d n l) r) AssocLeft++ filter' n = Infix (do+ d <- operator n+ i <- try (lookAhead identifier)+ return $ \l _ ->+ efun d i l) AssocLeft++ expr = parens term <|> apply EVar variable <|> apply ELit literal++pattern :: Parser m => m Pat+pattern = PWild <$ char '_' <|> PVar <$> variable <|> PLit <$> literal++collection :: Parser m => m Exp+collection = EVar <$> position <*> variable <|> ELit <$> position <*> 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 :: Parser m => m Var+variable = Var <$> (NonEmpty.fromList <$> sepBy1 identifier (char '.'))++identifier :: Parser m => m Id+identifier = ident variableStyle++spaces :: Parser m => m ()+spaces = skipMany (oneOf "\t ")++apply :: Parser m => (Delta -> a -> b) -> m a -> m b+apply f p = f <$> position <*> p++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++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/Syntax.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++-- Module : Text.EDE.Internal.Syntax+-- Copyright : (c) 2013-2014 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 view
@@ -0,0 +1,210 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}++-- Module : Text.EDE.Internal.Types+-- Copyright : (c) 2013-2014 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.Lens+import Data.Aeson.Types hiding (Result(..))+import Data.Foldable+import Data.HashMap.Strict (HashMap)+import Data.List.NonEmpty (NonEmpty(..))+import Data.Monoid hiding ((<>))+import Data.Maybe+import Data.Semigroup+import Data.Text (Text)+import Data.Text.Format (Format, format)+import Data.Text.Format.Params (Params)+import qualified Data.Text.Lazy as LText+import Text.PrettyPrint.ANSI.Leijen (Pretty(..), Doc, vsep)+import Text.Trifecta.Delta++-- | The result of running parsing or rendering steps.+data Result a+ = Success a+ | Failure Doc+ 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 (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 (vsep [e, e'])+ {-# INLINE (<|>) #-}+ empty = Failure mempty+ {-# INLINE empty #-}++instance Show a => Pretty (Result a) where+ pretty (Success x) = pretty (show x)+ pretty (Failure e) = pretty 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 :: (Doc -> b) -- ^ Function to apply to the 'Failure' case.+ -> (a -> b) -- ^ Function to apply to the 'Success' case.+ -> Result a -- ^ The 'Result' to map over.+ -> 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 => Doc -> m (Result a)+failure = return . Failure++throwError :: Params ps => Format -> ps -> Result a+throwError fmt = Failure . pretty . LText.unpack . format fmt++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 -> Text -> 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+ , _tmplIncl :: HashMap Text Exp+ } deriving (Eq)++type Id = Text++newtype Var = Var (NonEmpty Id)+ deriving (Eq, Show)++data Collection where+ Col :: Foldable f => Int -> f (Maybe Text, Value) -> Collection++data Pat+ = PWild+ | PVar !Var+ | PLit !Value+ deriving (Eq, Show)++type Alt = (Pat, Exp)++data Exp+ = ELit !Delta !Value+ | EVar !Delta !Var+ | EFun !Delta !Id+ | EApp !Delta !Exp !Exp+ | ELet !Delta !Id !Exp !Exp+ | ECase !Delta !Exp [Alt]+ | ELoop !Delta !Id !Exp !Exp+ | EIncl !Delta !Text+ deriving (Eq, Show)++instance HasDelta Exp where+ delta = \case+ ELit d _ -> d+ EVar d _ -> d+ EFun d _ -> d+ EApp d _ _ -> d+ ELet d _ _ _ -> d+ ECase d _ _ -> d+ ELoop d _ _ _ -> d+ EIncl d _ -> d++var :: Id -> Var+var = Var . (:| [])++eapp :: Delta -> [Exp] -> Exp+eapp d [] = ELit d (String mempty)+eapp _ [e] = e+eapp d (e:es) = foldl' (EApp d) e es++efun :: Delta -> Id -> Exp -> Exp+efun d = EApp d . EFun d++elet :: Delta -> Exp -> Maybe (Id, Exp) -> Exp+elet d e = \case+ Nothing -> e+ Just (i, b) -> ELet d i b e++ecase :: Exp -> [Alt] -> Maybe Exp -> Exp+ecase p ws f = ECase (delta p) p (ws ++ maybe [] ((:[]) . wild) f)++eif :: (Exp, Exp) -> [(Exp, Exp)] -> Maybe Exp -> Exp+eif t@(x, _) ts f = foldr' c (fromMaybe (bld (delta x)) f) (t:ts)+ where+ c (p, w) e = ECase (delta p) p [true w, false e]++eempty :: Delta -> Exp -> Exp -> Maybe Exp -> Exp+eempty d v e = maybe e (eif (efun d "!" (efun d "empty" v), e) [] . Just)++wild, true, false :: Exp -> Alt+wild = (PWild,)+true = (PLit (Bool True),)+false = (PLit (Bool False),)++bld :: Delta -> Exp+bld = (`ELit` String mempty)++-- | 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
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}++-- Module : Main+-- Copyright : (c) 2013 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 Main (main) where++import Control.Applicative+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.Text as Text+import qualified Data.Text.Lazy.Encoding as LText+import System.Directory+import System.IO.Unsafe+import Test.Tasty+import Test.Tasty.Golden+import Text.EDE++main :: IO ()+main = defaultMain . testGroup "ED-E" $ unsafePerformIO tests++resources :: FilePath+resources = "test/resources/"++include :: Resolver IO+include = includeFile resources++tests :: IO [TestTree]+tests = files >>= mapM test+ where+ files :: IO [FilePath]+ files = map (resources ++) . filter (isSuffixOf ".ede")+ <$> getDirectoryContents resources++ test :: FilePath -> IO TestTree+ test f = do+ (bs, n) <- (,)+ <$> BS.readFile f+ <*> pure (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 (error . show)+ (return . LText.encodeUtf8)+ (r >>= (`render` js))++ diff r n = ["diff", "-u", r, n]++ split = bimap input (BS.drop 4) . BS.breakSubstring "---"++ input = fromMaybe (error "Failed parsing JSON")+ . Aeson.decode'+ . LBS.fromStrict