packages feed

zinza (empty) → 0.1

raw patch · 38 files changed

+2080/−0 lines, 38 filesdep +basedep +bytestringdep +containers

Dependencies added: base, bytestring, containers, parsec, tasty, tasty-golden, tasty-hunit, text, transformers, zinza

Files

+ LICENSE view
@@ -0,0 +1,339 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The licenses for most software are designed to take away your+freedom to share and change it.  By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users.  This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it.  (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.)  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++  To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have.  You must make sure that they, too, receive or can get the+source code.  And you must show them these terms so they know their+rights.++  We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++  Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software.  If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++  Finally, any free program is threatened constantly by software+patents.  We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary.  To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++  The precise terms and conditions for copying, distribution and+modification follow.++                    GNU GENERAL PUBLIC LICENSE+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++  0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License.  The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language.  (Hereinafter, translation is included without limitation in+the term "modification".)  Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope.  The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++  1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++  2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++    a) You must cause the modified files to carry prominent notices+    stating that you changed the files and the date of any change.++    b) You must cause any work that you distribute or publish, that in+    whole or in part contains or is derived from the Program or any+    part thereof, to be licensed as a whole at no charge to all third+    parties under the terms of this License.++    c) If the modified program normally reads commands interactively+    when run, you must cause it, when started running for such+    interactive use in the most ordinary way, to print or display an+    announcement including an appropriate copyright notice and a+    notice that there is no warranty (or else, saying that you provide+    a warranty) and that users may redistribute the program under+    these conditions, and telling the user how to view a copy of this+    License.  (Exception: if the Program itself is interactive but+    does not normally print such an announcement, your work based on+    the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole.  If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works.  But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++  3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++    a) Accompany it with the complete corresponding machine-readable+    source code, which must be distributed under the terms of Sections+    1 and 2 above on a medium customarily used for software interchange; or,++    b) Accompany it with a written offer, valid for at least three+    years, to give any third party, for a charge no more than your+    cost of physically performing source distribution, a complete+    machine-readable copy of the corresponding source code, to be+    distributed under the terms of Sections 1 and 2 above on a medium+    customarily used for software interchange; or,++    c) Accompany it with the information you received as to the offer+    to distribute corresponding source code.  (This alternative is+    allowed only for noncommercial distribution and only if you+    received the program in object code or executable form with such+    an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it.  For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable.  However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++  4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License.  Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++  5. You are not required to accept this License, since you have not+signed it.  However, nothing else grants you permission to modify or+distribute the Program or its derivative works.  These actions are+prohibited by law if you do not accept this License.  Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++  6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions.  You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++  7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all.  For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices.  Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++  8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded.  In such case, this License incorporates+the limitation as if written in the body of this License.++  9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number.  If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation.  If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++  10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission.  For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this.  Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++                            NO WARRANTY++  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License along+    with this program; if not, write to the Free Software Foundation, Inc.,+    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++    Gnomovision version 69, Copyright (C) year name of author+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary.  Here is a sample; alter the names:++  Yoyodyne, Inc., hereby disclaims all copyright interest in the program+  `Gnomovision' (which makes passes at compilers) written by James Hacker.++  <signature of Ty Coon>, 1 April 1989+  Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs.  If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ fixtures/error-field.hs view
@@ -0,0 +1,1 @@+Error at 4:23: Field 'constructor' isn't in a record of type {con: String, name: String}
+ fixtures/error-field.txt view
@@ -0,0 +1,1 @@+Error at 4:23: Field 'constructor' isn't in a record of type {con: String, name: String}
+ fixtures/error-field.zinza view
@@ -0,0 +1,5 @@+Non-existing field:++{% for license in licenses %}+licenseName {{license.constructor}} = {{license.name}}+{% endfor %}
+ fixtures/error-string.hs view
@@ -0,0 +1,1 @@+Error at 3:3: Not a string [{con: String, name: String}]
+ fixtures/error-string.txt view
@@ -0,0 +1,1 @@+Error at 3:3: Not a string [{con: String, name: String}]
+ fixtures/error-string.zinza view
@@ -0,0 +1,3 @@+Trying to print not a string:++{{licenses}}
+ fixtures/error-typo.hs view
@@ -0,0 +1,1 @@+Error at 4:15: unbound variable 'licens'
+ fixtures/error-typo.txt view
@@ -0,0 +1,1 @@+Error at 4:15: unbound variable 'licens'
+ fixtures/error-typo.zinza view
@@ -0,0 +1,5 @@+Unbound variable:++{% for license in licenses %}+licenseName {{licens.con}} = {{license.name}}+{% endfor %}
+ fixtures/fancy.hs view
@@ -0,0 +1,25 @@+module DemoFancy (render) where+import Prelude (String, fst, snd, ($))+import Control.Monad (forM_)+import Fancy+import qualified Data.Map.Strict as Map+type Writer a = (String, a)+tell :: String -> Writer (); tell x = (x, ())+execWriter :: Writer a -> String; execWriter = fst+render :: Fancy -> String+render (z_root) = execWriter $ do+  tell (fancyString $ z_root)+  tell "\n"+  if (fancyBoolA $ z_root)+  then do+    forM_ (Map.toList $ fancyMap $ z_root) $ \z_var0_kv -> do+      tell (fst $ z_var0_kv)+      tell " -- "+      tell (snd $ z_var0_kv)+      tell "\n"+  else do+    if (fancyBoolB $ z_root)+    then do+      tell "Another output\n"+    else do+      tell "Third branch\n"
+ fixtures/fancy.txt view
@@ -0,0 +1,3 @@+fancy string+bar -- Bar+foo -- Foo
+ fixtures/fancy.zinza view
@@ -0,0 +1,12 @@+{# First comment #}+{{ string }}+{% if boolA %}+{# Second comment #}+{% for kv in map %}+{{ kv.key }} -- {{ kv.val }}+{% endfor %}+{% elif boolB %}+Another output+{% else %}+Third branch+{% endif %}
+ fixtures/licenses.hs view
@@ -0,0 +1,15 @@+module DemoLicenses (render) where+import Prelude (String, fst, snd, ($))+import Control.Monad (forM_)+import Licenses+type Writer a = (String, a)+tell :: String -> Writer (); tell x = (x, ())+execWriter :: Writer a -> String; execWriter = fst+render :: Licenses -> String+render (z_root) = execWriter $ do+  forM_ (licenses $ z_root) $ \z_var0_license -> do+    tell "licenseName "+    tell (licenseCon $ z_var0_license)+    tell " = "+    tell (licenseName $ z_var0_license)+    tell "\n"
+ fixtures/licenses.txt view
@@ -0,0 +1,2 @@+licenseName Foo = "foo-1.0"+licenseName Bar = "bar-1.2"
+ fixtures/licenses.zinza view
@@ -0,0 +1,3 @@+{% for license in licenses %}+licenseName {{license.con}} = {{license.name}}+{% endfor %}
+ fixtures/regression-c.hs view
@@ -0,0 +1,15 @@+module DemoLicenses (render) where+import Prelude (String, fst, snd, ($))+import Control.Monad (forM_)+import Licenses+type Writer a = (String, a)+tell :: String -> Writer (); tell x = (x, ())+execWriter :: Writer a -> String; execWriter = fst+render :: Licenses -> String+render (z_root) = execWriter $ do+  tell "int main() {\n"+  forM_ (licenses $ z_root) $ \z_var0_license -> do+    tell "  printf(\""+    tell (licenseCon $ z_var0_license)+    tell "\\n\");\n"+  tell "}\n"
+ fixtures/regression-c.txt view
@@ -0,0 +1,4 @@+int main() {+  printf("Foo\n");+  printf("Bar\n");+}
+ fixtures/regression-c.zinza view
@@ -0,0 +1,5 @@+int main() {+{% for license in licenses %}+  printf("{{license.con}}\n");+{% endfor %}+}
+ src/Zinza.hs view
@@ -0,0 +1,261 @@+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- SPDX-Identifier-Id: GPL-2.0-or-later AND BSD-3-Clause+--+-- Zinza - a small jinja-syntax-inspired typed-template compiler.+--+-- Zinza typechecks and compiles a template.+-- We can compile either to Haskell function, or to verbatim Haskell module (planned).+--+-- Zinza is very minimalistic. Features are added when needed.+--+-- == Example usage+--+-- Given a template+--+-- @+-- {% for license in licenses %}+-- licenseName {{license.con}} = {{license.name}}+-- {% endfor %}+-- @+--+-- and data definitions like:+--+-- @+-- newtype Licenses = Licenses { licenses :: [License] }+--   deriving (Generic)+--+-- data License = License+--     { licenseCon  :: String+--     , licenseName :: String+--     }+--   deriving (Generic)+-- @+--+-- We can (generically) derive 'Zinza' instances for @Licenses@ and @License@+--+-- @+-- instance 'Zinza' Licenses where+--     'toType'  = 'genericToType'  id+--     'toValue' = 'genericToValue' id+--+-- instance 'Zinza' License where+--     'toType'  = 'genericToTypeSFP'+--     'toValue' = 'genericToValueSFP'+-- @+--+-- Then the example of run-time usage is+--+-- @+-- example :: IO String+-- example = do+--     -- this might fail, type errors!+--     run <- 'parseAndCompileTemplateIO' "fixtures/licenses.zinza"+--     -- this shouldn't fail (run-time errors are due bugs in zinza)+--     run $ Licenses+--         [ License \"Foo" (show "foo-1.0")+--         , License \"Bar" (show "bar-1.2")+--         ]+-- @+--+-- The result of running an @example@ is:+--+-- @+-- licenseName Foo = "foo-1.0"+-- licenseName Bar = "bar-1.2"+-- @+--+-- == Module generation+--+-- Zinza also supports standalone module generation.+--+-- @+-- 'parseAndCompileModuleIO' ('simpleConfig' \"DemoLicenses\" [\"Licenses\"] :: 'ModuleConfig' Licenses) "fixtures/licenses.zinza" >>= putStr+-- @+--+-- prints a Haskell module source code:+--+-- @+-- module DemoLicenses (render) where+-- import Prelude (String, fst, snd, ($))+-- import Control.Monad (forM_)+-- import Licenses+-- type Writer a = (String, a)+-- tell :: String -> Writer (); tell x = (x, ())+-- execWriter :: Writer a -> String; execWriter = fst+-- render :: Licenses -> String+-- render (z_root) = execWriter $ do+--   forM_ (licenses $ z_root) $ \z_var0_license -> do+--     tell "licenseName "+--     tell (licenseCon $ z_var0_license)+--     tell " = "+--     tell (licenseName $ z_var0_license)+--     tell "\n"+-- @+--+-- which is not dependent on Zinza. You are free to use more efficient writer+-- as well.+--+-- === Expressions+--+-- @+-- {{ expression }}+-- @+--+-- Expression syntax has only two structures+--+-- * negated: @!foo@+--+-- * field access @foo.bar@+--+-- === Control structures+--+-- The __for__ and __if__ statements are supported:+--+-- @+-- {% for value in values %}+-- ...+-- {% endfor %}+-- @+--+-- @+-- {% if boolExpression %}+-- ...+-- {% elif anotherBoolExpression %}+-- ...+-- {% else %}+-- ...+-- {% endif %}+-- @+--+-- If a control structure tag starts at the first column, the possible+-- trailing new line feed is stripped. This way full-line control tags+-- don't introduce new lines in the output.+--+-- === Comments+--+-- @+-- {\# Comments are omitted from the output #}+-- @+--+module Zinza (+    parseAndCompileTemplate,+    parseAndCompileTemplateIO,+    -- * Compilation to Haskell module+    parseAndCompileModule,+    parseAndCompileModuleIO,+    ModuleConfig (..),+    simpleConfig,+    -- * Input class+    Zinza (..),+    -- ** Generic deriving+    genericToType,+    genericToValue,+    genericToTypeSFP,+    genericToValueSFP,+    stripFieldPrefix,+    GZinzaType, GZinzaValue, GFieldNames,+    -- * Templates+    Node (..), Nodes, Expr (..), LExpr,+    -- * Types+    -- | Zinza's type-system is delibarately extremely simple.+    Ty (..),+    displayTy,+    -- * Values+    -- | 'Value's are passed at run-time, when the template is interpreted.+    -- When compiled to the Haskell module, 'Value's aren't used.+    Value (..),+    -- * Errors+    ParseError (..),+    CompileError (..),+    CompileOrParseError (..),+    RuntimeError (..),+    AsRuntimeError (..),+    ThrowRuntime (..),+    -- * Location+    Loc (..), Located (..), zeroLoc, displayLoc, TraversableWithLoc (..),+    -- * Variables+    Var, Selector,+    ) where++import Control.Exception (throwIO)+import Data.Typeable     (Typeable, typeRep)++import Zinza.Check+import Zinza.Errors+import Zinza.Expr+import Zinza.Generic+import Zinza.Module+import Zinza.Node+import Zinza.Parser+import Zinza.Pos+import Zinza.Type+import Zinza.Value+import Zinza.Var++-- | Parse and compile the template into Haskell function.+parseAndCompileTemplate+    :: (Zinza a, ThrowRuntime m)+    => FilePath  -- ^ name of the template+    -> String    -- ^ contents of the template+    -> Either CompileOrParseError (a -> m String)+parseAndCompileTemplate name contents =+    case parseTemplate name contents of+        Left err    -> Left (AParseError err)+        Right nodes -> case check nodes of+            Left err' -> Left (ACompileError err')+            Right res -> Right res++-- | Like 'parseAndCompileTemplate' but reads file and (possibly)+-- throws 'CompileOrParseError'.+parseAndCompileTemplateIO :: (Zinza a, ThrowRuntime m) => FilePath -> IO (a -> m String)+parseAndCompileTemplateIO name = do+    contents <- readFile name+    either throwIO return $ parseAndCompileTemplate name contents++-- | Parse and compile the template into 'String' representing a Haskell module.+parseAndCompileModule+    :: Zinza a+    => ModuleConfig a+    -> FilePath+    -> String+    -> Either CompileOrParseError String+parseAndCompileModule mc name contents =+    case parseTemplate name contents of+        Left err -> Left (AParseError err)+        Right nodes -> case checkModule mc nodes of+            Left err  -> Left (ACompileError err)+            Right res -> Right res++-- | Like 'parseAndCompileModule' but reads file and (possibly)+-- throws 'CompileOrParseError'.+parseAndCompileModuleIO :: Zinza a => ModuleConfig a -> FilePath -> IO String+parseAndCompileModuleIO mc name = do+    contents <- readFile name+    either throwIO return $ parseAndCompileModule mc name contents++-- | Simple configuration to use with 'parseAndCompileModule' or+-- 'parseAndCompileModuleIO'.+simpleConfig+    :: forall a. Typeable a+    => String    -- ^ module name+    -> [String]  -- ^ imports+    -> ModuleConfig a+simpleConfig moduleName imports = ModuleConfig+    { mcRender = "render"+    , mcHeader =+        [ "module " ++ moduleName ++ " (render) where"+        , "import Prelude (String, fst, snd, ($))"+        , "import Control.Monad (forM_)"+        ] +++        [ "import " ++ i+        | i <- imports+        ] +++        [ "type Writer a = (String, a)"+        , "tell :: String -> Writer (); tell x = (x, ())"+        , "execWriter :: Writer a -> String; execWriter = fst"+        , "render :: " ++ typeName ++ " -> String"+        ]+    }+  where+    typeName = show (typeRep ([] :: [a]))
+ src/Zinza/Check.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE UndecidableInstances   #-}+module Zinza.Check (check) where++import Control.Monad         ((>=>))+import Data.Functor.Identity (Identity (..))+import Data.Proxy            (Proxy (..))+import Data.Traversable      (for)++import qualified Data.Map.Strict as M++import Zinza.Class+import Zinza.Errors+import Zinza.Expr+import Zinza.Indexing+import Zinza.Node+import Zinza.Pos+import Zinza.Type+import Zinza.Value+import Zinza.Var++-------------------------------------------------------------------------------+-- Nodes+-------------------------------------------------------------------------------++check :: forall a m. (Zinza a, ThrowRuntime m) => Nodes Var -> Either CompileError (a -> m String)+check nodes = case toType (Proxy :: Proxy a) of+    rootTy@(TyRecord env) -> do+        nodes' <- flip (traverse . traverseWithLoc) nodes $ \loc var ->+            case M.lookup var env of+                Nothing -> Left (UnboundTopLevelVar loc var)+                Just _  -> Right (EField (L loc (EVar (L loc (Identity rootTy)))) (L loc var))++        run <- checkNodes (map (>>== id) nodes')+        return $ fmap ($ "") . run . Identity . toValue++    rootTy -> throwRuntime (NotRecord zeroLoc rootTy)++checkNodes+    :: (Indexing v i, ThrowRuntime m)+    => Nodes (i Ty)  -- ^ nodes with root object+    -> Either CompileError (v Value -> m ShowS)+checkNodes nodes = do+    nodes' <- traverse checkNode nodes+    return $ \val -> do+        ss <- traverse ($ val) nodes'+        return (foldr (.) id ss)++checkNode :: (Indexing v i, ThrowRuntime m) => Node (i Ty) -> Either CompileError (v Value -> m ShowS)+checkNode NComment = return $ \_val -> return id+checkNode (NRaw s) = return $ \_val -> return (showString s)+checkNode (NIf expr xs ys) = do+    b' <- checkBool expr+    xs' <- checkNodes xs+    ys' <- checkNodes ys+    return $ \ctx -> do+        b'' <- b' ctx+        if b''+        then xs' ctx+        else ys' ctx+checkNode (NExpr e) = do+    e' <- checkString e+    return $ \ctx -> do+        s <- e' ctx+        return $ showString s+checkNode (NFor _v expr nodes) = do+    (expr', ty) <- checkList expr+    nodes' <- checkNodes (fmap (fmap (maybe (Here ty) There)) nodes)+    return $ \ctx -> do+        xs <- expr' ctx+        pieces <- for xs $ \x -> nodes' (x ::: ctx)+        return $ foldr (.) id pieces++-------------------------------------------------------------------------------+-- Expressions+-------------------------------------------------------------------------------++checkList :: (Indexing v i, ThrowRuntime m) => LExpr (i Ty) -> Either CompileError (v Value -> m [Value], Ty)+checkList e@(L l _) = do+    (e', ty) <- checkType e+    case ty of+        TyList _ ty' -> return (e' >=> go, ty')+        _            -> throwRuntime (NotList l ty)+  where+    go (VList xs) = return xs+    go x          = throwRuntime (NotList l (valueType x))++checkBool :: (Indexing v i, ThrowRuntime m) => LExpr (i Ty) -> Either CompileError (v Value -> m Bool)+checkBool e@(L l _) = do+    (e', ty) <- checkType e+    case ty of+        TyBool -> return (e' >=> go)+        _      -> throwRuntime (NotBool l ty)+  where+    go (VBool b) = return b+    go x         = throwRuntime (NotBool l (valueType x))++checkString :: (Indexing v i, ThrowRuntime m) => LExpr (i Ty) -> Either CompileError (v Value -> m String)+checkString e@(L l _) = do+    (e', ty) <- checkType e+    case ty of+        TyString _ -> return (e' >=> go)+        _          -> throwRuntime (NotString l ty)+  where+    go (VString b) = return b+    go x           = throwRuntime (NotString l (valueType x))++checkType :: (Indexing v i, ThrowRuntime m) => LExpr (i Ty) -> Either CompileError (v Value -> m Value, Ty)+checkType (L _ (EVar (L _ i))) = return (\v -> return (fst (index v i)), extract i)+checkType (L _ (ENot b)) = do+    b' <- checkBool b+    return (fmap (VBool . not) . b', TyBool)+checkType (L eLoc (EField e (L nameLoc name))) = do+    (e', ty) <- checkType e+    case ty of+        TyRecord tym -> case M.lookup name tym of+            Just (_sel, tyf) -> return (e' >=> go, tyf)+            Nothing          -> throwRuntime (FieldNotInRecord nameLoc name ty)+        _ -> throwRuntime (NotRecord eLoc ty)+  where+    go x@(VRecord r) = case M.lookup name r of+        Just y  -> return y+        Nothing -> throwRuntime (FieldNotInRecord nameLoc name (valueType x))+    go x = throwRuntime (NotRecord eLoc (valueType x))
+ src/Zinza/Class.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Zinza.Class (+    Zinza (..),+    ) where++import Data.Foldable (toList)+import Data.Proxy    (Proxy (..))++import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Lazy      as Map+import qualified Data.Set           as Set+import qualified Data.Text          as T+import qualified Data.Text.Lazy     as LT++import Zinza.Type+import Zinza.Value+--+-- $setup+-- >>> :set -XDeriveGeneric+-- >>> import Data.Proxy (Proxy (..))+-- >>> import GHC.Generics (Generic)+-- >>> import Zinza++-- | 'Zinza' class tells how to convert the type into template parameters,+-- and their types.+--+-- Class can be auto-derived for product types.+--+-- >>> data R = R { recFoo :: String, recBar :: Char } deriving Generic+-- >>> instance Zinza R where toType = genericToTypeSFP; toValue = genericToValueSFP+-- >>> displayTy $ toType (Proxy :: Proxy R)+-- "{bar: String, foo: String}"+--+class Zinza a where+    toType     :: Proxy a -> Ty+    toTypeList :: Proxy a -> Ty+    toTypeList = TyList Nothing . toType++    toValue     :: a   -> Value+    toValueList :: [a] -> Value+    toValueList = VList . map toValue++instance Zinza () where+    toType _  = tyUnit+    toValue _ = VRecord mempty++instance Zinza Bool where+    toType _ = TyBool+    toValue = VBool++instance Zinza Char where+    toType     _ = TyString (Just "return")+    toTypeList _ = TyString Nothing++    toValue     = VString . return+    toValueList = VString++instance Zinza a => Zinza [a] where+    toType _ = toTypeList (Proxy :: Proxy a)+    toValue = toValueList++instance (Zinza a, Zinza b) => Zinza (a, b) where+    toType _ = TyRecord $ Map.fromList+        [ ("fst", ("fst", toType (Proxy :: Proxy a)))+        , ("snd", ("snd", toType (Proxy :: Proxy b)))+        ]++    toValue (a, b) = VRecord $ Map.fromList+        [ ("fst", toValue a)+        , ("snd", toValue b)+        ]++-------------------------------------------------------------------------------+-- semigroups+-------------------------------------------------------------------------------++instance Zinza a => Zinza (NE.NonEmpty a) where+    toType _ = TyList Nothing (toType (Proxy :: Proxy a))+    toValue  = VList . map toValue . toList++-------------------------------------------------------------------------------+-- containers+-------------------------------------------------------------------------------++instance Zinza a => Zinza (Set.Set a) where+    toType _ = TyList Nothing (toType (Proxy :: Proxy a))+    toValue  = VList . map toValue . toList++-- | Pairs are encoded as @{key: k, val: v }@+instance (Zinza k, Zinza v) => Zinza (Map.Map k v) where+    toType _ = TyList (Just "Map.toList") $ TyRecord $ Map.fromList+        [ ("key", ("fst", toType (Proxy :: Proxy k)))+        , ("val", ("snd", toType (Proxy :: Proxy v)))+        ]++    toValue m = VList+        [ VRecord $ Map.fromList+            [ ("key", toValue k)+            , ("val", toValue v)+            ]+        | (k, v) <- Map.toList m+        ]++-------------------------------------------------------------------------------+-- text+-------------------------------------------------------------------------------++instance Zinza T.Text where+    toType _ = TyString (Just "T.unpack")+    toValue  = VString . T.unpack++instance Zinza LT.Text where+    toType _ = TyString (Just "LT.unpack")+    toValue  = VString . LT.unpack
+ src/Zinza/Errors.hs view
@@ -0,0 +1,91 @@+module Zinza.Errors where++import Control.Exception (Exception (..), throwIO)++import Zinza.Type+import Zinza.Var+import Zinza.Pos++errorLoc :: Loc -> String -> String+errorLoc l str = "Error at " ++ displayLoc l ++ ": " ++ str++-------------------------------------------------------------------------------+-- ParseError+-------------------------------------------------------------------------------++newtype ParseError = ParseError String+  deriving (Show)++instance Exception ParseError where+    displayException (ParseError err) = err++-------------------------------------------------------------------------------+-- CompileError+-------------------------------------------------------------------------------++data CompileError+    = UnboundTopLevelVar Loc Var+    | ARuntimeError RuntimeError+  deriving (Show)++instance Exception CompileError where+    displayException (UnboundTopLevelVar loc var) = errorLoc loc $+        "unbound variable '" ++ var ++ "'"+    displayException (ARuntimeError err) =+        displayException err+++-------------------------------------------------------------------------------+-- CompileOrParseError+-------------------------------------------------------------------------------++data CompileOrParseError+    = ACompileError CompileError+    | AParseError ParseError+  deriving (Show)++instance Exception CompileOrParseError where+    displayException (ACompileError err) = displayException err+    displayException (AParseError err)   = displayException err++-------------------------------------------------------------------------------+-- RuntimeError+-------------------------------------------------------------------------------++data RuntimeError+    = NotBool Loc Ty+    | NotString Loc Ty+    | NotRecord Loc Ty+    | NotList Loc Ty+    | FieldNotInRecord Loc Var Ty+  deriving Show++instance Exception RuntimeError where+    displayException (NotBool loc ty) = errorLoc loc $+        "Not a bool " ++ displayTy ty+    displayException (NotString loc ty) = errorLoc loc $+        "Not a string " ++ displayTy ty+    displayException (NotRecord loc ty) = errorLoc loc $+        "Not a record " ++ displayTy ty+    displayException (NotList loc ty) = errorLoc loc $+        "Not a list " ++ displayTy ty+    displayException (FieldNotInRecord loc var ty) = errorLoc loc $+        "Field '" ++ var ++ "' isn't in a record of type " ++ displayTy ty++-- | Class representing errors containing 'RuntimeError's.+--+-- Without bugs, compiled template should not throw any 'RuntimeError's,+-- as they are prevented statically, i.e. reported already as 'CompileError's.+--+class    AsRuntimeError e where asRuntimeError :: RuntimeError -> e+instance AsRuntimeError RuntimeError where asRuntimeError = id+instance AsRuntimeError CompileError where asRuntimeError = ARuntimeError++class Monad m => ThrowRuntime m where+    throwRuntime ::  RuntimeError -> m a++instance AsRuntimeError e => ThrowRuntime (Either e) where+    throwRuntime = Left . asRuntimeError++instance ThrowRuntime IO where+    throwRuntime = throwIO
+ src/Zinza/Expr.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveFoldable    #-}+{-# LANGUAGE DeriveFunctor     #-}+{-# LANGUAGE DeriveTraversable #-}+module Zinza.Expr (+    Expr (..),+    LExpr,+    abstract1,+    instantiate1ret,+    ) where++import Control.Monad (ap)+import Data.Maybe    (fromMaybe)++import Zinza.Var+import Zinza.Pos++-------------------------------------------------------------------------------+-- Node syntax+-------------------------------------------------------------------------------++-- | Expressions in templates.+--+-- Note: there are only eliminators; we cannot construct "bigger" expressions.+data Expr a+    = EVar (Located a)                -- ^ variable+    | EField (LExpr a) (Located Var)  -- ^ field accessor+    | ENot (LExpr a)                  -- ^ negation+  deriving (Show, Functor, Foldable, Traversable)++-- | Located expression.+type LExpr a = Located (Expr a)++instance TraversableWithLoc Expr where+    traverseWithLoc f (EVar (L l x)) = EVar . L l <$> f l x+    traverseWithLoc f (EField (L l e) v) = (\e' -> EField (L l e') v)+        <$> traverseWithLoc f e+    traverseWithLoc f (ENot (L l e)) = ENot . L l <$> traverseWithLoc f e++-- | 'Monad' instance gives substitution.+instance Monad Expr where+    return = EVar . L zeroLoc++    EVar (L _ x)           >>= k = k x+    EField (L l expr) var  >>= k = EField (L l (expr >>= k)) var+    ENot (L l expr)        >>= k = ENot (L l (expr >>= k))++instance Applicative Expr where+    pure = return+    (<*>) = ap++-------------------------------------------------------------------------------+-- "bound"+-------------------------------------------------------------------------------++-- | Abstraction.+abstract1 :: (Functor f, Eq a) => a -> f a -> f (Maybe a)+abstract1 x = fmap $ \y ->+    if x == y+    then Nothing+    else Just y++-- | Instantiate with a variable type+instantiate1ret :: Functor f => a -> f (Maybe a) -> f a+instantiate1ret = fmap . fromMaybe
+ src/Zinza/Generic.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE TypeOperators       #-}+module Zinza.Generic (+    Zinza (..),+    GFieldNames, stripFieldPrefix,+    GZinzaType, genericToType, genericToTypeSFP,+    GZinzaValue, genericToValue, genericToValueSFP,+    ) where++import Data.Char    (isLower, toLower)+import Data.Semigroup (Semigroup (..))+import Data.Kind    (Type)+import Data.List    (stripPrefix)+import Data.Proxy   (Proxy (..))+import GHC.Generics++import qualified Data.Map.Strict as M++import Zinza.Class+import Zinza.Type+import Zinza.Value+import Zinza.Var   (Var)++-- $setup+-- >>> :set -XDeriveGeneric+-- >>> import Data.Proxy (Proxy (..))++-------------------------------------------------------------------------------+-- Field renamer+-------------------------------------------------------------------------------++-- | Field renamer which will automatically strip lowercase prefix from+-- field names.+--+-- >>> data R = R { recFoo :: Int, recBar :: Char } deriving Generic+-- >>> stripFieldPrefix (Proxy :: Proxy R) "recFoo"+-- "foo"+--+-- If whole field is lower case, it's left intact+--+-- >>> newtype Wrapped = Wrap { unwrap :: String } deriving Generic+-- >>> stripFieldPrefix (Proxy :: Proxy Wrapped) "unwrap"+-- "unwrap"+--+stripFieldPrefix+    :: forall a. (Generic a, GFieldNames (Rep a))+    => Proxy a+    -> String -> String+stripFieldPrefix _ = case fieldNames (Proxy :: Proxy (Rep a)) of+    []     -> id+    (y:ys) -> \fn -> case stripPrefix pfx fn of+        Just (x:xs) -> toLower x : xs+        _           -> fn -- otherwise don't hcange+      where+        (pfx, _) = span isLower $ getCommonPrefix $ foldl (\cp z -> cp <> CP z) (CP y) ys++class GFieldNames (f :: Type -> Type) where+    fieldNames :: Proxy f -> [String]++instance (i ~ D, GFieldNamesSum f) => GFieldNames (M1 i c f) where+    fieldNames _ = fieldNamesSum (Proxy :: Proxy f)++class GFieldNamesSum (f :: Type -> Type) where+    fieldNamesSum :: Proxy f -> [String]++instance (i ~ C, GFieldNamesProd f) => GFieldNamesSum (M1 i c f ) where+    fieldNamesSum _ = fieldNamesProd (Proxy :: Proxy f)++class GFieldNamesProd (f :: Type -> Type) where+    fieldNamesProd :: Proxy f -> [String]++instance (GFieldNamesProd f, GFieldNamesProd g) => GFieldNamesProd (f :*: g) where+    fieldNamesProd _ = fieldNamesProd (Proxy :: Proxy f) ++ fieldNamesProd (Proxy :: Proxy g)++instance (i ~ S, Selector c) => GFieldNamesProd (M1 i c f) where+    fieldNamesProd _ = [selName (undefined :: M1 i c f ())]++-------------------------------------------------------------------------------+-- Common prefix+-------------------------------------------------------------------------------++newtype CommonPrefix = CP { getCommonPrefix :: String }++instance Data.Semigroup.Semigroup CommonPrefix where+    CP a <> CP b = CP (commonPrefix a b)++commonPrefix :: Eq a => [a] -> [a] -> [a]+commonPrefix xs@[]  _      = xs+commonPrefix _      ys@[]  = ys+commonPrefix (x:xs) (y:ys)+    | x == y    = x : commonPrefix xs ys+    | otherwise = []++-------------------------------------------------------------------------------+-- Generic toType+-------------------------------------------------------------------------------++-- | Generically derive 'toType' function.+genericToType+    :: forall a. (Generic a, GZinzaType (Rep a))+    => (String -> String)  -- ^ field renamer+    -> Proxy a -> Ty+genericToType namer _ = TyRecord $ M.fromList+    [ (namer fn, (fn, ty))+    | (fn, ty) <- gtoType (Proxy :: Proxy (Rep a))+    ]++-- | 'genericToType' with 'stripFieldPrefix'.+genericToTypeSFP+    :: forall a. (Generic a, GZinzaType (Rep a), GFieldNames (Rep a))+    => Proxy a -> Ty+genericToTypeSFP p = genericToType (stripFieldPrefix p) p++class GZinzaType (f :: Type -> Type) where+    gtoType :: Proxy f -> [(String, Ty)]++instance (i ~ D, GZinzaTypeSum f) => GZinzaType (M1 i c f) where+    gtoType _ = gtoTypeSum (Proxy :: Proxy f)++class GZinzaTypeSum (f :: Type -> Type) where+    gtoTypeSum :: Proxy f -> [(String, Ty)]++instance (i ~ C, GZinzaTypeProd f) => GZinzaTypeSum (M1 i c f ) where+    gtoTypeSum _ = gtoTypeProd (Proxy :: Proxy f)++class GZinzaTypeProd (f :: Type -> Type) where+    gtoTypeProd :: Proxy f -> [(String, Ty)]++instance (GZinzaTypeProd f, GZinzaTypeProd g) => GZinzaTypeProd (f :*: g) where+    gtoTypeProd _ = gtoTypeProd (Proxy :: Proxy f) ++ gtoTypeProd (Proxy :: Proxy g)++instance (i ~ S, Selector c, GZinzaTypeLeaf f) => GZinzaTypeProd (M1 i c f) where+    gtoTypeProd _ = [(selName (undefined :: M1 i c f ()), gtoTypeLeaf (Proxy :: Proxy f))]++class GZinzaTypeLeaf (f :: Type -> Type) where+    gtoTypeLeaf :: Proxy f -> Ty++instance (i ~ R, Zinza a) => GZinzaTypeLeaf (K1 i a) where+    gtoTypeLeaf _ = toType (Proxy :: Proxy a)++-------------------------------------------------------------------------------+-- Generic toValue+-------------------------------------------------------------------------------++-- | Generically derive 'toValue' function.+genericToValue+    :: forall a. (Generic a, GZinzaValue (Rep a))+    => (String -> String)  -- ^ field renamer+    -> a -> Value+genericToValue namer x = VRecord $ M.fromList+    [ (namer fn, e)+    | (fn, e) <- gtoValue (from x)+    ]++-- | 'genericToValue' with 'stripFieldPrefix'.+genericToValueSFP+    :: forall a. (Generic a, GZinzaValue (Rep a), GFieldNames (Rep a))+    => a -> Value+genericToValueSFP = genericToValue (stripFieldPrefix (Proxy :: Proxy a))++class GZinzaValue (f :: Type -> Type) where+    gtoValue :: f () -> [(Var, Value)]++instance (i ~ D, GZinzaValueSum f) => GZinzaValue (M1 i c f) where+    gtoValue = gtoValueSum .  unM1++class GZinzaValueSum (f :: Type -> Type) where+    gtoValueSum :: f () -> [(Var, Value)]++instance (i ~ C, GZinzaValueProd f) => GZinzaValueSum (M1 i c f) where+    gtoValueSum = gtoValueProd . unM1++class GZinzaValueProd (f :: Type -> Type) where+    gtoValueProd :: f () -> [(Var, Value)]++instance (GZinzaValueProd f, GZinzaValueProd g) => GZinzaValueProd (f :*: g) where+    gtoValueProd (f :*: g) = gtoValueProd f ++ gtoValueProd g++instance (i ~ S, Selector c, GZinzaValueLeaf f) => GZinzaValueProd (M1 i c f) where+    gtoValueProd (M1 x) = [(selName (undefined :: M1 i c f ()), gtoValueLeaf x)]++class GZinzaValueLeaf f where+    gtoValueLeaf :: f a -> Value++instance (i ~ R, Zinza a) => GZinzaValueLeaf (K1 i a) where+    gtoValueLeaf (K1 a) = toValue a
+ src/Zinza/Indexing.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances   #-}+module Zinza.Indexing where++import Data.Functor.Identity (Identity (..))++class Indexing v i | i -> v, v -> i where+    extract :: i a -> a+    index   :: v a -> i b -> (a, b)++instance Indexing Identity Identity where+    extract = runIdentity+    index (Identity a) (Identity b) = (a, b)++data Idx f a+    = Here a+    | There (f a)++data Cons f a = a ::: f a++instance Indexing v i => Indexing (Cons v) (Idx i) where+    extract (Here b)   = b+    extract (There bs) = extract bs++    index (a ::: _)  (Here b)   = (a, b)+    index (_ ::: as) (There bs) = index as bs
+ src/Zinza/Module.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE UndecidableInstances #-}+-- | This module has the same shape as "Zinza.Check".+module Zinza.Module (+    checkModule,+    ModuleConfig (..),+    ) where++import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State (StateT (..), get, modify')+import Data.Foldable             (traverse_)+import Data.Maybe                (fromMaybe)+import Data.Proxy                (Proxy (..))++import qualified Data.Map.Strict as M++import Zinza.Class+import Zinza.Errors+import Zinza.Expr+import Zinza.Node+import Zinza.Pos+import Zinza.Type+import Zinza.Var++-------------------------------------------------------------------------------+-- Monad+-------------------------------------------------------------------------------++type M = StateT S (Either CompileError)++data S = S+    { sOutput :: [(Int, String)] -> [(Int, String)]+    , sIndent :: Int+    , sVars  :: Int+    }++tell :: String -> M ()+tell str = modify' $ \s -> s { sOutput = sOutput s . ((sIndent s, str) :)}++indented :: M a -> M a+indented m = do+    modify' $ \s -> s { sIndent = succ (sIndent s) }+    x <- m+    modify' $ \s -> s { sIndent = pred (sIndent s) }+    return x++newVar :: String -> M Selector+newVar name = do+    n <- sVars <$> get+    modify' $ \s -> s { sVars = succ n }+    return ("z_var" ++ show n ++ "_" ++ name)+++flatten :: [(Int, String)] -> String+flatten xs = unlines+    [ replicate (i + i) ' ' ++ str+    | (i, str) <- xs+    ]++-------------------------------------------------------------------------------+-- ModuleConfig+-------------------------------------------------------------------------------++-- | Configuration for module rendering+data ModuleConfig a = ModuleConfig+    { mcHeader :: [String]  -- ^ module header+    , mcRender :: String    -- ^ name of the function+    }+  deriving Show++-------------------------------------------------------------------------------+-- Compilation+-------------------------------------------------------------------------------++checkModule+    :: forall a. Zinza a+    => ModuleConfig a+    -> Nodes Var+    -> Either CompileError String+checkModule mc nodes =  case toType (Proxy :: Proxy a) of+    TyRecord env -> do+        nodes' <- flip (traverse .traverseWithLoc) nodes $ \loc var ->+            case M.lookup var env of+                Nothing        -> Left (UnboundTopLevelVar loc var)+                Just (sel, ty) -> Right (rootExpr `access` sel, ty)++        ((), S out _ _) <- runStateT (header *> indented (checkNodes nodes')) (S id 0 0)+        return (flatten (out []))+    rootTy -> throwRuntime (NotRecord zeroLoc rootTy)+  where+    header = do+        traverse_ tell (mcHeader mc)+        tell $ mcRender mc ++ " " ++ displayHsExpr rootExpr ++ " = execWriter $ do"++    rootExpr :: HsExpr+    rootExpr = hsVar "z_root"++checkNodes :: Nodes (HsExpr, Ty) -> M ()+checkNodes = traverse_ checkNode++checkNode :: Node (HsExpr, Ty) -> M ()+checkNode NComment = return ()+checkNode (NRaw s) = tell $ "tell " ++ show s+checkNode (NExpr expr) = do+    expr' <- lift $ checkString expr+    tell $ "tell " ++ displayHsExpr expr'+checkNode (NIf expr xs ys) = do+    expr' <- lift $ checkBool expr+    tell $ "if " ++ displayHsExpr expr'+    tell "then do"+    indented $ checkNodes xs+    tell "else do"+    indented $ checkNodes ys+checkNode (NFor v expr nodes) = do+    v' <- newVar v+    (expr', ty) <- lift (checkList expr)+    tell $ "forM_ " ++ displayHsExpr expr' ++ " $ \\" ++ v' ++ " -> do"+    indented $ checkNodes $ map (fmap (fromMaybe (hsVar v', ty))) nodes++-------------------------------------------------------------------------------+-- Expression+-------------------------------------------------------------------------------++checkList :: LExpr (HsExpr, Ty) -> Either CompileError (HsExpr, Ty)+checkList e@(L l _) = do+    (e', ty) <- checkType e+    case ty of+        TyList sel ty' -> return (e' `accessMaybe` sel, ty')+        _ ->  throwRuntime (NotList l ty)++checkString :: LExpr (HsExpr, Ty) -> Either CompileError HsExpr+checkString e@(L l _) = do+    (e', ty) <- checkType e+    case ty of+        TyString sel -> return (e' `accessMaybe` sel)+        _            -> throwRuntime (NotString l ty)++checkBool :: LExpr (HsExpr, Ty) -> Either CompileError HsExpr+checkBool e@(L l _) = do+    (e', ty) <- checkType e+    case ty of+        TyBool -> return e'+        _      -> throwRuntime (NotBool l ty)++checkType :: LExpr (HsExpr, Ty) -> Either CompileError (HsExpr, Ty)+checkType (L _ (EVar (L _ x))) = return x+checkType (L _ (ENot b)) = do+    b' <- checkBool b+    return (b' `access` "not", TyBool)+checkType (L eLoc (EField e (L nameLoc name))) =do+    (e', ty) <- checkType e+    case ty of+        TyRecord tym -> case M.lookup name tym of+            Just (sel, tyf) -> return (e' `access` sel, tyf)+            Nothing         -> throwRuntime (FieldNotInRecord nameLoc name ty)+        _ -> throwRuntime (NotRecord eLoc ty)
+ src/Zinza/Node.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE DeriveFoldable    #-}+{-# LANGUAGE DeriveFunctor     #-}+{-# LANGUAGE DeriveTraversable #-}+module Zinza.Node (+    Nodes,+    Node (..),+    (>>==),+    ) where++import Zinza.Expr+import Zinza.Var+import Zinza.Pos++-- | A list of 'Node's.+type Nodes a = [Node a]++-- | Template parts.+--+-- We use polymorphic recursion for de Bruijn indices.+-- See materials on @bound@ library.+--+data Node a+    = NRaw  String                           -- ^ raw text block+    | NExpr (LExpr a)                        -- ^ expression @expr : String@+    | NIf   (LExpr a) (Nodes a) (Nodes a)   -- ^ conditional block, @expr : Bool@+    | NFor  Var (LExpr a) (Nodes (Maybe a))  -- ^ for loop, @expr : List a@+    | NComment                               -- ^ comments+  deriving (Show, Functor, Foldable, Traversable)++instance TraversableWithLoc Node where+    traverseWithLoc _ NComment   = pure NComment+    traverseWithLoc _ (NRaw s)   = pure (NRaw s)+    traverseWithLoc f (NExpr e)  = NExpr+        <$> traverse (traverseWithLoc f) e+    traverseWithLoc f (NIf e xs ys) = NIf+        <$> traverse (traverseWithLoc f) e+        <*> traverse (traverseWithLoc f) xs+        <*> traverse (traverseWithLoc f) ys+    traverseWithLoc f (NFor v e ns) = NFor v+        <$> traverse (traverseWithLoc f) e+        <*> traverse (traverseWithLoc f') ns+      where+        f' _ Nothing  = pure Nothing+        f' l (Just x) = Just <$> f l x++-- | Substitution.+(>>==) :: Node a -> (a -> Expr b) -> Node b+NComment               >>== _ = NComment+NRaw s                 >>== _ = NRaw s+NExpr (L l expr)       >>== k = NExpr (L l (expr >>= k))+NIf (L l expr) xs ys   >>== k = NIf (L l (expr >>= k)) (map (>>== k) xs) (map (>>== k) ys)+NFor var (L l expr) ns >>== k = NFor var (L l (expr >>= k)) (map (>>== traverse k) ns)
+ src/Zinza/Parser.hs view
@@ -0,0 +1,176 @@+module Zinza.Parser (parseTemplate) where++import Control.Applicative (many, optional, some, (<|>))+import Control.Monad       (void)+import Data.Char           (isAlphaNum, isLower)+import Data.Maybe          (isJust)+import Text.Parsec+       (eof, getPosition, lookAhead, notFollowedBy, parse, anyChar, satisfy, try)+import Text.Parsec.Char    (char, space, spaces, string)+import Text.Parsec.Pos     (SourcePos, sourceColumn, sourceLine)+import Text.Parsec.String  (Parser)++import Zinza.Errors+import Zinza.Expr+import Zinza.Node+import Zinza.Pos+import Zinza.Var++-- | Parse template into nodes. No other than syntactic checks are performed.+parseTemplate+    :: FilePath  -- ^ name of the template+    -> String    -- ^ contents of the template+    -> Either ParseError (Nodes Var)+parseTemplate input contents+    = either (Left . ParseError . show) Right+    $ parse (nodesP <* eof) input contents++-------------------------------------------------------------------------------+-- Location+-------------------------------------------------------------------------------++toLoc :: SourcePos -> Loc+toLoc p = Loc (sourceLine p) (sourceColumn p)++-------------------------------------------------------------------------------+-- Parser+-------------------------------------------------------------------------------++varP :: Parser Var+varP = (:) <$> satisfy isLower <*> many (satisfy isVarChar)++located :: Parser a -> Parser (Located a)+located p = do+    pos <- getPosition+    L (toLoc pos) <$> p++locVarP :: Parser (Located Var)+locVarP = located varP++isVarChar :: Char -> Bool+isVarChar c = isAlphaNum c || c == '_'++nodeP :: Parser (Node Var)+nodeP = commentP <|> directiveP <|> exprNodeP <|> newlineN <|> rawP++nodesP :: Parser (Nodes Var)+nodesP = many nodeP++newlineN :: Parser (Node Var)+newlineN = NRaw . pure <$> char '\n'++rawP :: Parser (Node Var)+rawP = mk <$> some rawCharP <*> optional (char '\n') where+    rawCharP   = notBrace <|> try (char '{' <* lookAhead notSpecial)+    notBrace   = satisfy $ \c -> c /= '{' && c /= '\n'+    notSpecial = satisfy $ \c -> c /= '{' && c /= '%' && c /= '#'++    mk s Nothing  = NRaw s+    mk s (Just c) = NRaw (s ++ [c])++exprNodeP :: Parser (Node Var)+exprNodeP = do+    _ <- try (string "{{")+    spaces+    expr <- located exprP+    spaces+    _ <- string "}}"+    return (NExpr expr)++exprP :: Parser (Expr Var)+exprP = do+    b <- optional (char '!')+    v@(L l _) <- locVarP+    vs <- many (char '.' *> locVarP)+    let expr = foldl (\e f -> EField (L l e) f) (EVar v) vs+    return $+        if isJust b+        then ENot (L l expr)+        else expr++commentP :: Parser (Node var)+commentP = do+    pos <- getPosition+    _ <- try (string "{#")+    go pos+  where+    go pos = do+        c <- anyChar+        case c of+            '#' -> do+                c' <- anyChar+                case c' of+                    '}' -> NComment <$ eatNewlineWhen (sourceColumn pos == 1)+                    _   -> go pos+            _   -> go pos+    +eatNewlineWhen :: Bool -> Parser ()+eatNewlineWhen False = return ()+eatNewlineWhen True  = void (optional (char '\n'))++directiveP :: Parser (Node Var)+directiveP = forP <|> ifP++spaces1 :: Parser ()+spaces1 = space *> spaces++open :: String -> Parser Bool+open n = do+    pos <- getPosition+    _ <- try $ string "{%" *> spaces *> string n *> spaces+    return $ sourceColumn pos == 1  -- parsec counts pos from 1, not zero.++close :: String -> Parser ()+close n = do+    on0 <- open ("end" ++ n)+    close' on0++close' :: Bool -> Parser ()+close' on0 = do+    _ <- string "%}"+    eatNewlineWhen on0++forP :: Parser (Node Var)+forP = do+    on0 <- open "for"+    var <- varP+    spaces1+    _ <- string "in"+    notFollowedBy $ satisfy isAlphaNum+    spaces1+    expr <- located exprP+    spaces1+    close' on0+    ns <- nodesP+    close "for"+    return $ NFor var expr (abstract1 var <$> ns)++ifP :: Parser (Node Var)+ifP = do+    on0 <- open "if"+    expr <- located exprP+    spaces+    close' on0+    ns <- nodesP+    closing (NIf expr ns)+  where+    closing mk = closeIf mk <|> elifP mk <|> elseP mk++    closeIf mk = do+        close "if"+        return (mk [])++    elseP mk = do+        on0 <- open "else"+        close' on0+        ns <- nodesP+        close "if"+        return (mk ns)++    elifP mk = do+        on0 <- open "elif"+        expr <- located exprP+        spaces+        close' on0+        ns <- nodesP+        closing (mk . pure . NIf expr ns)
+ src/Zinza/Pos.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveFoldable    #-}+{-# LANGUAGE DeriveFunctor     #-}+{-# LANGUAGE DeriveTraversable #-}+module Zinza.Pos where++-- | Location, line and column.+data Loc = Loc !Int !Int+  deriving (Eq, Show)++-- | /Unknown/ location.+zeroLoc :: Loc+zeroLoc = Loc 0 0++-- | Pretty-print location.+displayLoc :: Loc -> String+displayLoc (Loc l c) = show l ++ ":" ++ show c++-- | Located element.+data Located a = L {-# UNPACK #-} !Loc a+  deriving (Eq, Show, Functor, Foldable, Traversable)++-- | Some containers have location for each element.+class Traversable t => TraversableWithLoc t where+    traverseWithLoc :: Applicative f => (Loc -> a -> f b) -> t a -> f (t b)
+ src/Zinza/Type.hs view
@@ -0,0 +1,51 @@+module Zinza.Type (+    Ty (..),+    tyUnit,+    displayTy,+    ) where++import qualified Data.Map as M++import Zinza.Var++-- $setup+-- >>> import Zinza+-- >>> import Data.Proxy (Proxy (..))++-- | Zinza types.+--+-- The 'selector's tell how the Haskell value can be+-- converted to primitive value. E.g.+--+-- >>> toType (Proxy :: Proxy Char)+-- TyString (Just "return")+--+-- Here, 'return' converts 'Char' to 'String'.+--+data Ty+    = TyBool                                 -- ^ boolean+    | TyString (Maybe Selector)              -- ^ string+    | TyList (Maybe Selector) Ty             -- ^ lists+    | TyRecord (M.Map Var (Selector, Ty))    -- ^ records+  deriving (Eq, Ord, Show)++-- | A record without fields is a unit type. Think of zero-field tuple: @()@.+tyUnit :: Ty+tyUnit = TyRecord M.empty++-- | Pretty print 'Ty'.+displayTy :: Ty -> String+displayTy ty = go ty "" where+    go :: Ty -> ShowS+    go TyBool       = showString "Bool"+    go (TyString _) = showString "String"+    go (TyList _ t) = showChar '[' . go t . showChar ']'+    go (TyRecord m) = case M.toList m of+        []            -> showString "{}"+        ((n,(_,t)) : nts) -> foldl+            (\acc (n',(_,t')) -> acc . showString ", " . showPair n' t')+            (showChar '{' . showPair n t)+            nts+            . showChar '}'++    showPair n t = showString n . showString ": " . go t
+ src/Zinza/Value.hs view
@@ -0,0 +1,24 @@+module Zinza.Value where++import qualified Data.Map.Strict as M++import Zinza.Var+import Zinza.Type++-- | Template values.+data Value+    = VBool Bool                 -- ^ booleans+    | VString String             -- ^ strings+    | VList [Value]              -- ^ lists+    | VRecord (M.Map Var Value)  -- ^ records+  deriving (Show)++-- | Calculate 'Ty' of the 'Value'.+-- This is only an approximation, for list we look at first+-- element if it exists, otherwise we use 'unitTy'.+valueType :: Value -> Ty+valueType (VBool _)     = TyBool+valueType (VString _)   = TyString Nothing+valueType (VList [])    = TyList Nothing tyUnit+valueType (VList (v:_)) = TyList Nothing (valueType v)+valueType (VRecord m)   = TyRecord (fmap (\v -> ("", valueType v)) m)
+ src/Zinza/Var.hs view
@@ -0,0 +1,24 @@+module Zinza.Var where++import Data.List.NonEmpty (NonEmpty (..), cons)++-- | Variable name, possibly a fieldname in the record.+type Var = String++-- | Haskell selector.+type Selector = String++-- | A very simple haskell expression+newtype HsExpr = HsExpr (NonEmpty Selector)++hsVar :: Selector -> HsExpr+hsVar = HsExpr . pure++access :: HsExpr -> Selector -> HsExpr+access (HsExpr xs) x = HsExpr (cons x xs)++accessMaybe :: HsExpr -> Maybe Selector -> HsExpr+accessMaybe e = maybe e (access e)++displayHsExpr :: HsExpr -> String+displayHsExpr (HsExpr xs) = "(" ++ foldr1 (\a b -> a ++ " $ " ++ b) xs ++ ")"
+ src/Zinza/Writer.hs view
@@ -0,0 +1,52 @@+module Zinza.Writer (+    Writer,+    execWriter,+    tell,+    ) where++-- | 'String' writer monad.+newtype Writer a = Writer { unWriter :: ShowS -> (ShowS, a) }++-- | Get the written string.+execWriter :: Writer a -> String+execWriter w = fst (unWriter w id) ""++-- | Tell 'String'.+tell :: String -> Writer ()+tell x = Writer $ \s -> (s . showString x, ())++instance Functor Writer where+    fmap f m = Writer $ \s -> fmap f (unWriter m s)++instance Applicative Writer where+    pure x = Writer $ \s -> (s, x)+    {-# INLINE pure #-}++    x *> y = Writer $ \s1 ->+        let (s2, _) = unWriter x s1+        in unWriter y s2+    {-# INLINE (*>) #-}++    x <* y = Writer $ \s1 ->+        let (s2, x') = unWriter x s1+            (s3, _)  = unWriter y s2+            in (s3, x')+    {-# INLINE (<*) #-}++    f <*> x = Writer $ \s1 ->+        let (s2, f') = unWriter f s1+            (s3, x') = unWriter x s2+            in (s3, f' x')+    {-# INLINE (<*>) #-}++instance Monad Writer where+    return = pure+    {-# INLINE return #-}++    (>>) = (*>)+    {-# INLINE (>>) #-}++    m >>= k = Writer $ \s1 ->+        let (s2, x) = unWriter m s1+        in unWriter (k x) s2+    {-# INLINE (>>=) #-}
+ test/Fancy.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE DeriveGeneric #-}+module Fancy where++import Data.Map     (Map)+import GHC.Generics (Generic (..))++import Zinza++data Fancy = Fancy+    { fancyBoolA  :: Bool+    , fancyBoolB  :: Bool+    , fancyString :: String+    , fancyMap    :: Map String String+    }+  deriving (Generic)++instance Zinza Fancy where+    toType  = genericToTypeSFP+    toValue = genericToValueSFP
+ test/Licenses.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveGeneric #-}+module Licenses where++import GHC.Generics      (Generic (..))++import Zinza++newtype Licenses = Licenses { licenses :: [License] }+  deriving (Generic)++instance Zinza Licenses where+    toType  = genericToType  id+    toValue = genericToValue id++data License = License+    { licenseCon  :: String+    , licenseName :: String+    }+  deriving (Show, Generic)++instance Zinza License where+    toType  = genericToTypeSFP+    toValue = genericToValueSFP
+ test/Tests.hs view
@@ -0,0 +1,100 @@+module Main (main) where++import Control.Exception (displayException, throwIO)+import Test.Tasty        (TestName, TestTree, defaultMain, testGroup)+import Test.Tasty.Golden (goldenVsStringDiff)+import Test.Tasty.HUnit  (testCase, (@?=))++import qualified Data.ByteString.Lazy.Char8 as LBS8+import qualified Data.Map.Strict            as Map++import Fancy+import Licenses++import Zinza++main :: IO ()+main = defaultMain $ testGroup "Zinza"+    [ testCase "example" $ do+          ex <- example+          ex @?= unlines+              [ "licenseName Foo = \"foo-1.0\""+              , "licenseName Bar = \"bar-1.2\""+              ]+    , testGroup "Golden"+        [ testGolden lics licsMC "licenses"+        , testGolden lics licsMC "error-typo"+        , testGolden lics licsMC "error-field"+        , testGolden lics licsMC "error-string"+        , testGolden lics licsMC "regression-c"+        , testGolden fancy fancyMC "fancy"+        ]+    ]+  where+    testGolden :: Zinza a => a -> ModuleConfig a -> TestName -> TestTree+    testGolden input mc name = testGroup name+        [ goldenVsStringDiff "txt" diff ("fixtures/" ++ name ++ ".txt") $ do+            contents <- readFile $ "fixtures/" ++ name ++ ".zinza"+            case parseAndCompileTemplate "" contents of+                Left err -> return (LBS8.pack (displayException err))+                Right run -> case run input of+                    Left err  -> return (LBS8.pack (displayException (err :: RuntimeError)))+                    Right res -> return (LBS8.pack res)+        , goldenVsStringDiff "module" diff ("fixtures/" ++ name ++ ".hs") $ do+            contents <- readFile $ "fixtures/" ++ name ++ ".zinza"+            case parseAndCompileModule mc "" contents of+                Left err  -> return (LBS8.pack (displayException err))+                Right mdl -> return (LBS8.pack mdl)+        ]++    diff :: FilePath -> FilePath -> [String]+    diff ref new = ["diff", "-u", ref, new]++-------------------------------------------------------------------------------+-- Licenses+-------------------------------------------------------------------------------++lics :: Licenses+lics = Licenses+    [ License "Foo" (show "foo-1.0")+    , License "Bar" (show "bar-1.2")+    ]++licsMC :: ModuleConfig Licenses+licsMC = simpleConfig "DemoLicenses" ["Licenses"]++-------------------------------------------------------------------------------+-- Fancy+-------------------------------------------------------------------------------++fancy :: Fancy+fancy = Fancy+    { fancyBoolA  = True+    , fancyBoolB  = True+    , fancyString = "fancy string"+    , fancyMap = Map.fromList+        [ ("foo", "Foo")+        , ("bar", "Bar")+        ]+    }++fancyMC :: ModuleConfig Fancy+fancyMC = simpleConfig "DemoFancy" ["Fancy", "qualified Data.Map.Strict as Map"]++-------------------------------------------------------------------------------+-- Example+-------------------------------------------------------------------------------++example :: IO String+example = do+    contents <- readFile "fixtures/licenses.zinza"+    -- this might fail+    run <- runEither $ parseAndCompileTemplate "" contents+    -- this shouldn't fail (run-time errors are due bugs in zinza)+    run $ Licenses+        [ License "Foo" (show "foo-1.0")+        , License "Bar" (show "bar-1.2")+        ]+  where+    runEither (Left err) = throwIO err+    runEither (Right x)  = return x
+ zinza.cabal view
@@ -0,0 +1,69 @@+cabal-version:      2.2+name:               zinza+version:            0.1+synopsis:           Typed templates with jinja like syntax+category:           Text, Template+description:+  Typed templates with jinja like syntax. Well-typed templates don't go wrong.++license:            GPL-2.0-or-later+license-file:       LICENSE+maintainer:         Oleg Grenrus <oleg.grenrus@iki.fi>+copyright:          (c) 2019 Oleg Grenrus+author:             Oleg.Grenrus <oleg.grenrus@iki.fi>+homepage:           https://github.com/phadej/zinza+bug-reports:        https://github.com/phadej/zinza/issues+tested-with:        GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1+extra-source-files:+  fixtures/*.zinza+  fixtures/*.hs+  fixtures/*.txt++source-repository head+  type:     git+  location: https://github.com/phadej/zinza.git++library+  default-language: Haskell2010+  hs-source-dirs:   src+  exposed-modules:  Zinza+  build-depends:+    , base          ^>=4.10.0.0 || ^>=4.11.0.0 || ^>=4.12.0.0 || ^>=4.13.0.0+    , containers    ^>=0.5.10.2 || ^>=0.6.0.1+    , parsec        ^>=3.1.13.0+    , text          ^>=1.2.3.0+    , transformers  ^>=0.5.2.0++  other-modules:+    Zinza.Check+    Zinza.Class+    Zinza.Errors+    Zinza.Expr+    Zinza.Generic+    Zinza.Indexing+    Zinza.Module+    Zinza.Node+    Zinza.Parser+    Zinza.Pos+    Zinza.Type+    Zinza.Value+    Zinza.Var+    Zinza.Writer++test-suite zinza-tests+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Tests.hs+  other-modules:+    Fancy+    Licenses++  build-depends:+    , base+    , bytestring    ^>=0.10.8.2+    , containers+    , tasty         ^>=1.2.3+    , tasty-golden  ^>=2.3.2+    , tasty-hunit   ^>=0.10.0.2+    , zinza