diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,7 @@ +# 0.2.1 + +- Support GHC-8.6.5...9.10.1 + # 0.2 - Implement defining and using _blocks_ diff --git a/src/Zinza/Check.hs b/src/Zinza/Check.hs --- a/src/Zinza/Check.hs +++ b/src/Zinza/Check.hs @@ -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)) diff --git a/src/Zinza/Class.hs b/src/Zinza/Class.hs --- a/src/Zinza/Class.hs +++ b/src/Zinza/Class.hs @@ -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) diff --git a/src/Zinza/Expr.hs b/src/Zinza/Expr.hs --- a/src/Zinza/Expr.hs +++ b/src/Zinza/Expr.hs @@ -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 diff --git a/src/Zinza/Generic.hs b/src/Zinza/Generic.hs --- a/src/Zinza/Generic.hs +++ b/src/Zinza/Generic.hs @@ -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) diff --git a/src/Zinza/Module.hs b/src/Zinza/Module.hs --- a/src/Zinza/Module.hs +++ b/src/Zinza/Module.hs @@ -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) diff --git a/src/Zinza/Node.hs b/src/Zinza/Node.hs --- a/src/Zinza/Node.hs +++ b/src/Zinza/Node.hs @@ -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] diff --git a/src/Zinza/Type.hs b/src/Zinza/Type.hs --- a/src/Zinza/Type.hs +++ b/src/Zinza/Type.hs @@ -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') diff --git a/src/Zinza/Value.hs b/src/Zinza/Value.hs --- a/src/Zinza/Value.hs +++ b/src/Zinza/Value.hs @@ -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'. diff --git a/zinza.cabal b/zinza.cabal --- a/zinza.cabal +++ b/zinza.cabal @@ -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 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