zinza 0.2 → 0.2.1
raw patch · 10 files changed
+68/−54 lines, 10 filesdep ~QuickCheckdep ~basedep ~containers
Dependency ranges changed: QuickCheck, base, containers, tasty, transformers
Files
- Changelog.md +4/−0
- src/Zinza/Check.hs +17/−17
- src/Zinza/Class.hs +2/−2
- src/Zinza/Expr.hs +2/−2
- src/Zinza/Generic.hs +4/−4
- src/Zinza/Module.hs +12/−12
- src/Zinza/Node.hs +1/−1
- src/Zinza/Type.hs +4/−4
- src/Zinza/Value.hs +2/−2
- zinza.cabal +20/−10
Changelog.md view
@@ -1,3 +1,7 @@+# 0.2.1++- Support GHC-8.6.5...9.10.1+ # 0.2 - Implement defining and using _blocks_
src/Zinza/Check.hs view
@@ -1,15 +1,15 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}+{-# 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 Control.Monad.Trans.State (StateT (..), evalStateT, put, get)+import Control.Monad ((>=>)) import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State (StateT (..), evalStateT, get, put)+import Data.Functor.Identity (Identity (..))+import Data.Proxy (Proxy (..))+import Data.Traversable (for) -import qualified Data.Map.Strict as M+import qualified Data.Map.Strict as Map import Zinza.Class import Zinza.Errors@@ -25,7 +25,7 @@ -- Type ------------------------------------------------------------------------------- -type Check v m = StateT (M.Map Var (v Value -> m ShowS)) (Either CompileError)+type Check v m = StateT (Map.Map Var (v Value -> m ShowS)) (Either CompileError) ------------------------------------------------------------------------------- -- Nodes@@ -35,11 +35,11 @@ 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+ case Map.lookup var env of Nothing -> Left (UnboundTopLevelVar loc var) Just _ -> Right (EField (L loc (EVar (L loc (Identity rootTy)))) (L loc var)) - run <- evalStateT (checkNodes (map (>>== id) nodes')) M.empty+ run <- evalStateT (checkNodes (map (>>== id) nodes')) Map.empty return $ fmap ($ "") . run . Identity . toValue rootTy -> throwRuntime (NotRecord zeroLoc rootTy)@@ -79,22 +79,22 @@ blocks <- get nodes' <- lift $ evalStateT (checkNodes (fmap (fmap (maybe (Here ty) There)) nodes))- (M.map (\f (_ ::: xs) -> f xs) blocks)+ (Map.map (\f (_ ::: xs) -> f xs) blocks) return $ \ctx -> do xs <- expr' ctx pieces <- for xs $ \x -> nodes' (x ::: ctx) return $ foldr (.) id pieces checkNode (NDefBlock l n nodes) = do blocks <- get- if M.member n blocks+ if Map.member n blocks then lift (Left (ShadowingBlock l n)) else do nodes' <- checkNodes nodes- put $ M.insert n nodes' blocks+ put $ Map.insert n nodes' blocks return $ \_ -> return id checkNode (NUseBlock l n) = do blocks <- get- case M.lookup n blocks of+ case Map.lookup n blocks of Nothing -> lift (Left (UnboundUseBlock l n)) Just block -> return block @@ -145,12 +145,12 @@ checkType (L eLoc (EField e (L nameLoc name))) = do (e', ty) <- checkType e case ty of- TyRecord tym -> case M.lookup name tym of+ TyRecord tym -> case Map.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+ go x@(VRecord r) = case Map.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
@@ -14,8 +14,8 @@ import qualified Data.Text.Lazy as LT import Zinza.Errors-import Zinza.Type import Zinza.Pos+import Zinza.Type import Zinza.Value -- -- $setup@@ -109,7 +109,7 @@ instance (Zinza a, Zinza b) => Zinza (a -> b) where toType _ = TyFun (toType (Proxy :: Proxy a)) (toType (Proxy :: Proxy b)) toValue f = VFun $ fmap (toValue . f) . fromValue zeroLoc- fromValue l (VFun f) = return $ + fromValue l (VFun f) = return $ either throw id . (>>= fromValue l) . f . toValue fromValue l v = throwRuntime $ NotFunction l (valueType v)
src/Zinza/Expr.hs view
@@ -11,8 +11,8 @@ import Control.Monad (ap) import Data.Maybe (fromMaybe) -import Zinza.Var import Zinza.Pos+import Zinza.Var ------------------------------------------------------------------------------- -- Node syntax@@ -46,7 +46,7 @@ EVar (L _ x) >>= k = k x EField (L l expr) var >>= k = EField (L l (expr >>= k)) var- EApp (L lx x) (L ly y) >>= k = EApp (L lx (x >>= k)) (L ly (y >>= k)) + EApp (L lx x) (L ly y) >>= k = EApp (L lx (x >>= k)) (L ly (y >>= k)) instance Applicative Expr where pure = return
src/Zinza/Generic.hs view
@@ -17,7 +17,7 @@ import Data.Semigroup (Semigroup (..)) import GHC.Generics -import qualified Data.Map.Strict as M+import qualified Data.Map.Strict as Map import Zinza.Class import Zinza.Errors@@ -105,7 +105,7 @@ :: forall a. (Generic a, GZinzaType (Rep a)) => (String -> String) -- ^ field renamer -> Proxy a -> Ty-genericToType namer _ = TyRecord $ M.fromList+genericToType namer _ = TyRecord $ Map.fromList [ (namer fn, (fn, ty)) | (fn, ty) <- gtoType (Proxy :: Proxy (Rep a)) ]@@ -152,7 +152,7 @@ :: forall a. (Generic a, GZinzaValue (Rep a)) => (String -> String) -- ^ field renamer -> a -> Value-genericToValue namer x = VRecord $ M.fromList+genericToValue namer x = VRecord $ Map.fromList [ (namer fn, e) | (fn, e) <- gtoValue (from x) ]@@ -199,7 +199,7 @@ => (String -> String) -- ^ field renamer -> Loc -> Value -> Either RuntimeError a genericFromValue namer l v@(VRecord m) = do- g <- gfromValue l (valueType v) $ \n -> M.lookup (namer n) m+ g <- gfromValue l (valueType v) $ \n -> Map.lookup (namer n) m return (to g) genericFromValue _ l v = throwRuntime $ NotRecord l (valueType v)
src/Zinza/Module.hs view
@@ -12,7 +12,7 @@ import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..)) -import qualified Data.Map.Strict as M+import qualified Data.Map.Strict as Map import Zinza.Class import Zinza.Errors@@ -32,7 +32,7 @@ { sOutput :: [(Int, String)] -> [(Int, String)] , sIndent :: Int , sVars :: Int- , sBlocks :: M.Map Var HsExpr+ , sBlocks :: Map.Map Var HsExpr } tell :: String -> M ()@@ -81,11 +81,11 @@ 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+ case Map.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 M.empty)+ ((), S out _ _ _) <- runStateT (header *> indented (checkNodes nodes')) (S id 0 0 Map.empty) return (flatten (out [])) rootTy -> throwRuntime (NotRecord zeroLoc rootTy) where@@ -111,11 +111,11 @@ tell "then do" indented $ do resettingBlocks $ checkNodes xs- tell $ "return ()"+ tell "return ()" tell "else do" indented $ do resettingBlocks $ checkNodes ys- tell $ "return ()"+ tell "return ()" checkNode (NFor v expr nodes) = do v' <- newVar v (expr', ty) <- lift (checkList expr)@@ -123,20 +123,20 @@ indented $ checkNodes $ map (fmap (fromMaybe (hsVar v', ty))) nodes checkNode (NDefBlock l n nodes) = do blocks <- fmap sBlocks get- if M.member n blocks+ if Map.member n blocks then lift (Left (UnboundUseBlock l n)) else do v' <- fmap hsVar (newVar n)- tell $ "let"+ tell "let" indented $ do tell $ displayHsExpr v' ++ " = do" indented $ do checkNodes nodes- tell $ "return ()"- modify' $ \s' -> s' { sBlocks = M.insert n v' blocks }+ tell "return ()"+ modify' $ \s' -> s' { sBlocks = Map.insert n v' blocks } checkNode (NUseBlock l n) = do S _ _ _ blocks <- get- case M.lookup n blocks of+ case Map.lookup n blocks of Nothing -> lift (Left (UnboundUseBlock l n)) Just block -> tell $ displayHsExpr block @@ -177,7 +177,7 @@ checkType (L eLoc (EField e (L nameLoc name))) =do (e', ty) <- checkType e case ty of- TyRecord tym -> case M.lookup name tym of+ TyRecord tym -> case Map.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
@@ -8,8 +8,8 @@ ) where import Zinza.Expr-import Zinza.Var import Zinza.Pos+import Zinza.Var -- | A list of 'Node's. type Nodes a = [Node a]
src/Zinza/Type.hs view
@@ -4,7 +4,7 @@ displayTy, ) where -import qualified Data.Map as M+import qualified Data.Map as Map import Zinza.Var @@ -26,13 +26,13 @@ = TyBool -- ^ boolean | TyString (Maybe Selector) -- ^ string | TyList (Maybe Selector) Ty -- ^ lists- | TyRecord (M.Map Var (Selector, Ty)) -- ^ records+ | TyRecord (Map.Map Var (Selector, Ty)) -- ^ records | TyFun Ty Ty -- ^ functions deriving (Eq, Ord, Show) -- | A record without fields is a unit type. Think of zero-field tuple: @()@. tyUnit :: Ty-tyUnit = TyRecord M.empty+tyUnit = TyRecord Map.empty -- | Pretty print 'Ty'. displayTy :: Ty -> String@@ -41,7 +41,7 @@ go _ TyBool = showString "Bool" go _ (TyString _) = showString "String" go _ (TyList _ t) = showChar '[' . go 0 t . showChar ']'- go _ (TyRecord m) = case M.toList m of+ go _ (TyRecord m) = case Map.toList m of [] -> showString "{}" ((n,(_,t)) : nts) -> foldl (\acc (n',(_,t')) -> acc . showString ", " . showPair n' t')
src/Zinza/Value.hs view
@@ -1,6 +1,6 @@ module Zinza.Value where -import qualified Data.Map.Strict as M+import qualified Data.Map.Strict as Map import Zinza.Errors import Zinza.Type@@ -11,7 +11,7 @@ = VBool Bool -- ^ booleans | VString String -- ^ strings | VList [Value] -- ^ lists- | VRecord (M.Map Var Value) -- ^ records+ | VRecord (Map.Map Var Value) -- ^ records | VFun (Value -> Either RuntimeError Value) -- ^ function -- | Calculate 'Ty' of the 'Value'.
zinza.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: zinza-version: 0.2+version: 0.2.1 synopsis: Typed templates with jinja like syntax category: Text, Template description:@@ -13,12 +13,22 @@ 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+tested-with:+ GHC ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.5+ || ==9.8.2+ || ==9.10.1+ extra-source-files: Changelog.md- fixtures/*.zinza fixtures/*.hs fixtures/*.txt+ fixtures/*.zinza source-repository head type: git@@ -29,11 +39,11 @@ 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+ , base ^>=4.12.0.0 || ^>=4.13.0.0 || ^>=4.14.0.0 || ^>=4.15.0.0 || ^>=4.16.0.0 || ^>=4.17.0.0 || ^>=4.18.0.0 || ^>=4.19.0.0 || ^>=4.20.0.0+ , containers ^>=0.6.0.1 || ^>=0.7 , parsec ^>=3.1.13.0- , text ^>=1.2.3.0- , transformers ^>=0.5.2.0+ , text ^>=1.2.3.0 || ^>=2.0 || ^>=2.1+ , transformers ^>=0.5.6.2 || ^>=0.6.0.2 other-modules: Zinza.Check@@ -64,11 +74,11 @@ build-depends: , base- , bytestring ^>=0.10.8.2+ , bytestring ^>=0.10.8.2 || ^>=0.11.1.0 || ^>=0.12.0.2 , containers- , QuickCheck ^>=2.13.2+ , QuickCheck ^>=2.15 , quickcheck-instances ^>=0.3.22- , tasty ^>=1.2.3+ , tasty ^>=1.5 , tasty-golden ^>=2.3.2 , tasty-hunit ^>=0.10.0.2 , tasty-quickcheck ^>=0.10.1