packages feed

compdata 0.12.1 → 0.13.1

raw patch · 39 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,10 @@+0.13.1+---++- Compatibility with GHC 9.8++0.13+---++- Compatibility with GHC 9.2, 9.4, 9.6+- GHC version 9.0 and older no longer supported
benchmark/Benchmark.hs view
@@ -45,7 +45,7 @@ standardBenchmarks  (sExpr,aExpr,n) = rnf aExpr `seq` rnf sExpr `seq` getBench n     where getBench n = bgroup n paperBenchmarks           -- these are the benchmarks for evaluation-          evalBenchmarks = [+          _evalBenchmarks = [                  bench "evalDesug" (nf A.desugEval2 aExpr),                  bench "evalDesug (fusion)" (nf A.desugEval2' aExpr),                  bench "evalDesug (comparison)" (nf S.desugEval2 sExpr),@@ -97,7 +97,7 @@                  bench "freeVarsU" (nf S.freeVarsGen sExpr),                  bench "freeVars (comparison)" (nf S.freeVars sExpr)]           -- these are all the benchmarks-          allBenchmarks = [+          _allBenchmarks = [                  bench "Comp.desug" (nf A.desugExpr aExpr),                  bench "Comp.desug'" (nf A.desugExpr' aExpr),                  bench "Comp.desugAlg" (nf A.desugExpr2 aExpr),
benchmark/Functions/Comp/Desugar.hs view
@@ -20,6 +20,8 @@ class (Functor e, Traversable f) => Desug f e where     desugAlg :: Hom f e +$(derive [liftSum] [''Desug])+ desugExpr :: SugarExpr -> Expr desugExpr = desug @@ -33,8 +35,6 @@ desug' :: Desug f e => Term f -> Term e {-# INLINE desug' #-} desug' = appHom' desugAlg--$(derive [liftSum] [''Desug])  instance (Value :<: v, Functor v) => Desug Value v where     desugAlg = liftCxt
benchmark/Functions/Comp/Eval.hs view
@@ -30,11 +30,11 @@ class (Monad m, Traversable v) => EvalT e v m where     evalTAlg :: AlgT m e v +$(derive [liftSum] [''EvalT])+ evalT :: (EvalT e v m, Functor e) => Term e -> m (Term v) evalT = nf . cata evalTAlg -$(derive [liftSum] [''EvalT])- instance (Monad m, Traversable v, Value :<: m :+: v) => EvalT Value v m where     evalTAlg = inject @@ -100,11 +100,11 @@ class Monad m => Eval e v m where     evalAlg :: e (Term v) -> m (Term v) +$(derive [liftSum] [''Eval])+ eval :: (Traversable e, Eval e v m) => Term e -> m (Term v) eval = cataM evalAlg -$(derive [liftSum] [''Eval])- instance (Value :<: v, Monad m) => Eval Value v m where     evalAlg = return . inject @@ -150,14 +150,14 @@ class MonadFail m => EvalDir e m where     evalDir :: (Traversable f, EvalDir f m) => e (Term f) -> m ValueExpr +$(derive [liftSum] [''EvalDir])+ evalDirect :: (Traversable e, EvalDir e m) => Term e -> m ValueExpr evalDirect (Term x) = evalDir x  evalDirectE :: SugarExpr -> Err ValueExpr evalDirectE = evalDirect -$(derive [liftSum] [''EvalDir])- instance (MonadFail m) => EvalDir Value m where     evalDir (VInt i) = return $ iVInt i     evalDir (VBool i) = return $ iVBool i@@ -213,11 +213,11 @@ class Functor e => Eval2 e v where     eval2Alg :: e (Term v) -> Term v +$(derive [liftSum] [''Eval2])+ eval2 :: (Functor e, Eval2 e v) => Term e -> Term v eval2 = cata eval2Alg -$(derive [liftSum] [''Eval2])- instance (Value :<: v) => Eval2 Value v where     eval2Alg = inject @@ -264,13 +264,13 @@ class EvalDir2 e where     evalDir2 :: (EvalDir2 f) => e (Term f) -> ValueExpr +$(derive [liftSum] [''EvalDir2])+ evalDirect2 :: (EvalDir2 e) => Term e -> ValueExpr evalDirect2 (Term x) = evalDir2 x  evalDirectE2 :: SugarExpr -> ValueExpr evalDirectE2 = evalDirect2--$(derive [liftSum] [''EvalDir2])  instance EvalDir2 Value where     evalDir2 (VInt i) = iVInt i
compdata.cabal view
@@ -1,13 +1,12 @@ Name:			compdata-Version:		0.12.1+Version:		0.13.1 Synopsis:            	Compositional Data Types Description: -  This library implements the ideas of /Data types a la carte/-  (Journal of Functional Programming, 18(4):423-436, 2008,-  <http://dx.doi.org/10.1017/S0956796808006758>) as outlined in the-  paper /Compositional data types/ (Workshop on Generic Programming,-  83-94, 2011, <http://dx.doi.org/10.1145/2036918.2036930>). The+  This library implements the ideas of+  <http://dx.doi.org/10.1017/S0956796808006758 Data types a la carte>+  as outlined in the paper+  <http://dx.doi.org/10.1145/2036918.2036930 Compositional data types>. The   purpose of this library is to allow the programmer to construct data   types -- as well as the functions defined on them -- in a modular   fashion. The underlying idea is to separate the signature of a data@@ -77,19 +76,16 @@   There are some supplementary packages, some of which were included   in previous versions of this package:   .-  * @compdata-param@-    <https://hackage.haskell.org/package/compdata-param>: a parametric-    variant of compositional data types to deal with variable binders-    in a systematic way.+  * <https://hackage.haskell.org/package/compdata-param compdata-param>:+    a parametric variant of compositional data types to deal with variable+    binders in a systematic way.   .-  * @compdata-automata@-    <https://hackage.haskell.org/package/compdata-automata>: advanced-    recursion schemes derived from tree automata that allow for a+  * <https://hackage.haskell.org/package/compdata-automata compdata-automata>:+    advanced recursion schemes derived from tree automata that allow for a     higher degree of modularity and make it possible to apply fusion.   .-  * @compdata-dags@-    <https://hackage.haskell.org/package/compdata-dags>: recursion-    schemes on directed acyclic graphs.+  * <https://hackage.haskell.org/package/compdata-dags compdata-dags>:+    recursion schemes on directed acyclic graphs.   Category:               Generics@@ -98,10 +94,11 @@ Author:                 Patrick Bahr, Tom Hvitved Maintainer:             paba@itu.dk Build-Type:             Simple-Cabal-Version:          >=1.12+Cabal-Version:          >=1.9.2 bug-reports:            https://github.com/pa-ba/compdata/issues  extra-source-files:+  CHANGELOG.md   -- test files   testsuite/tests/*.hs   testsuite/tests/Data/*.hs@@ -190,10 +187,17 @@   -  Build-Depends:	base >= 4.9, base < 5, template-haskell, containers, mtl >= 2.2.1,-                        QuickCheck >= 2, deepseq, transformers, th-expand-syns,-                        tree-view >= 0.5-  Default-Language:     Haskell2010                                                +  Build-Depends:        base >= 4.16 && < 4.19,+                        QuickCheck >= 2.14.3 && < 2.15,+                        containers >= 0.6.8 && < 0.7,+                        deepseq >= 1.4 && < 1.6,+                        template-haskell >= 2.17 && < 2.22,+                        mtl >= 2.3.1 && < 2.4,+                        transformers >= 0.6.1 && < 0.7,+                        th-expand-syns >= 0.4.11 && < 0.5,+                        tree-view >= 0.5.1 && < 0.6++  Default-Language:     Haskell2010   Default-Extensions:   FlexibleContexts   hs-source-dirs:	src   ghc-options:          -W@@ -203,9 +207,10 @@   Type:                 exitcode-stdio-1.0   Main-is:		Data_Test.hs   hs-source-dirs:	testsuite/tests examples src-  Build-Depends:        base >= 4.9, base < 5, template-haskell, containers, mtl >= 2.2.1,+  Build-Depends:        base >= 4.16 && < 5, template-haskell, containers, mtl >= 2.2.1,                         QuickCheck >= 2, HUnit, test-framework, test-framework-hunit,                         test-framework-quickcheck2 >= 0.3, deepseq, transformers, th-expand-syns+  Default-Language:     Haskell2010    ghc-options:          -W -Wno-incomplete-patterns   Other-Modules:@@ -282,7 +287,7 @@         Examples.Multi.EvalI         Examples.Multi.EvalM         Test.Utils-  Default-Language:     Haskell2010+                            Benchmark algebra   Type:                 exitcode-stdio-1.0@@ -291,9 +296,10 @@   ghc-options:          -W -O2   -- Disable short-cut fusion rules in order to compare optimised and unoptimised code.   cpp-options:          -DNO_RULES-  Build-Depends:        base >= 4.9, base < 5, template-haskell, containers, mtl >= 2.2.1,+  Build-Depends:        base >= 4.16 && < 5, template-haskell, containers, mtl >= 2.2.1,                         QuickCheck >= 2, deepseq, criterion, random, uniplate, transformers,                         th-expand-syns+  Default-Language:     Haskell2010   Other-Modules:         Data.Comp         Data.Comp.Algebra@@ -337,8 +343,7 @@         Functions.Standard.Eval         Functions.Standard.FreeVars         Functions.Standard.Inference-  Default-Language:     Haskell2010-        + source-repository head   type:     git   location: https://github.com/pa-ba/compdata
src/Data/Comp/Arbitrary.hs view
@@ -38,7 +38,7 @@     arbitraryF' = map addP arbitraryF'         where addP (i,gen) =  (i,(:&:) <$> gen <*> arbitrary)     arbitraryF = (:&:) <$> arbitraryF <*> arbitrary-    shrinkF (v :&: p) = tail [v' :&: p'| v' <- v: shrinkF v, p' <- p : shrink p ]+    shrinkF (v :&: p) = drop 1 [v' :&: p'| v' <- v: shrinkF v, p' <- p : shrink p ]  {-|   This lifts instances of 'ArbitraryF' to instances of 'ArbitraryF' for
src/Data/Comp/Derive/Arbitrary.hs view
@@ -114,5 +114,5 @@                  binds <- mapM (\(var,resVar) -> bindS (varP resVar) [| $(varE var) : shrink $(varE var) |]) $ zip varNs resVarNs                  let ret = NoBindS $ AppE (VarE 'return) (foldl1 AppE ( ConE constr: map VarE resVarNs ))                      stmtSeq = binds ++ [ret]-                     pat = ConP constr $ map VarP varNs-                 return $ Clause [pat] (NormalB $ AppE (VarE 'tail) (DoE stmtSeq)) []+                     pat = ConP constr [] $ map VarP varNs+                 return $ Clause [pat] (NormalB $ AppE (VarE 'tail) (DoE Nothing stmtSeq)) []
src/Data/Comp/Derive/DeepSeq.hs view
@@ -44,7 +44,7 @@             genRnfFClause (constr, args,_) = do               let n = length args               varNs <- newNames n "x"-              let pat = ConP constr $ map VarP varNs+              let pat = ConP constr [] $ map VarP varNs                   allVars = map varE varNs               body <- foldr (\ x y -> [|rnf $x `seq` $y|]) [| () |] allVars               return $ Clause [pat] (NormalB body) []
src/Data/Comp/Derive/Equality.hs view
@@ -46,8 +46,8 @@             genEqClause (constr, n) = do               varNs <- newNames n "x"               varNs' <- newNames n "y"-              let pat = ConP constr $ map VarP varNs-                  pat' = ConP constr $ map VarP varNs'+              let pat = ConP constr [] $ map VarP varNs+                  pat' = ConP constr [] $ map VarP varNs'                   vars = map VarE varNs                   vars' = map VarE varNs'                   mkEq x y = let (x',y') = (return x,return y)
src/Data/Comp/Derive/Foldable.hs view
@@ -57,7 +57,7 @@             filterVar [d] x =Just (d, varE x)             filterVar _ _ =  error "functor variable occurring twice in argument type"             filterVars args varNs = catMaybes $ zipWith filterVar args varNs-            mkCPat constr args varNs = ConP constr $ zipWith mkPat args varNs+            mkCPat constr args varNs = ConP constr [] $ zipWith mkPat args varNs             mkPat [] _ = WildP             mkPat _ x = VarP x             mkPatAndVars (constr, args) =
src/Data/Comp/Derive/HaskellStrict.hs view
@@ -92,7 +92,7 @@             filterVar farg _ [depth] x = farg depth x             filterVar _ _ _ _ = error "functor variable occurring twice in argument type"             filterVars args varNs farg nonFarg = zipWith (filterVar farg nonFarg) args varNs-            mkCPat constr varNs = ConP constr $ map mkPat varNs+            mkCPat constr varNs = ConP constr [] $ map mkPat varNs             mkPat = VarP             mkClauses (constr, args) =                 do varNs <- newNames (length args) "x"
src/Data/Comp/Derive/Ordering.hs view
@@ -56,8 +56,8 @@             genEqClause (constr, n) = do               varNs <- newNames n "x"               varNs' <- newNames n "y"-              let pat = ConP constr $ map VarP varNs-                  pat' = ConP constr $ map VarP varNs'+              let pat = ConP constr [] $ map VarP varNs+                  pat' = ConP constr [] $ map VarP varNs'                   vars = map VarE varNs                   vars' = map VarE varNs'                   mkEq x y = let (x',y') = (return x,return y)
src/Data/Comp/Derive/Show.hs view
@@ -54,7 +54,7 @@             genShowFClause fArg (constr, args, gadtTy) = do               let n = length args               varNs <- newNames n "x"-              let pat = ConP constr $ map VarP varNs+              let pat = ConP constr [] $ map VarP varNs                   allVars = zipWith (filterFarg (getUnaryFArg fArg gadtTy)) args varNs                   shows = listE $ map mkShow allVars                   conName = nameBase constr@@ -90,7 +90,7 @@             genShowConstrClause fArg (constr, args, gadtTy) = do               let n = length args               varNs <- newNames n "x"-              let pat = ConP constr $ map VarP varNs+              let pat = ConP constr [] $ map VarP varNs                   allVars = zipWith (filterFarg (getUnaryFArg fArg gadtTy)) args varNs                   shows = listE $ map mkShow allVars                   conName = nameBase constr
src/Data/Comp/Derive/SmartConstructors.hs view
@@ -54,6 +54,6 @@                     ftype = foldl appT (conT tname) (map varT targs')                     constr = (conT ''(:<:) `appT` ftype) `appT` f                     typ = foldl appT (conT ''Cxt) [h, f, a]-                    typeSig = forallT (map PlainTV vars) (sequence [constr]) typ+                    typeSig = forallT (map (\ v -> PlainTV v SpecifiedSpec) vars) (sequence [constr]) typ                 sigD sname typeSig               genSig _ _ _ _ = []
src/Data/Comp/Derive/Traversable.hs view
@@ -55,7 +55,7 @@             filterVar farg _ [depth] x = farg depth x             filterVar _ _ _ _ = error "functor variable occurring twice in argument type"             filterVars args varNs farg nonFarg = zipWith (filterVar farg nonFarg) args varNs-            mkCPat constr varNs = ConP constr $ map mkPat varNs+            mkCPat constr varNs = ConP constr [] $ map mkPat varNs             mkPat = VarP             mkPatAndVars (constr, args) =                 do varNs <- newNames (length args) "x"
src/Data/Comp/Derive/Utils.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE CPP #-} -------------------------------------------------------------------------------- -- |@@ -20,21 +21,8 @@ import Language.Haskell.TH.Syntax import Language.Haskell.TH.ExpandSyns --- reportError is introduced only from version 7.6 of GHC-#if __GLASGOW_HASKELL__ < 706-reportError :: String -> Q ()-reportError = report True-#endif+data DataInfo = forall flag . DataInfo Cxt Name [TyVarBndr flag] [Con] [DerivClause]  -#if __GLASGOW_HASKELL__ < 800-data DataInfo = DataInfo Cxt Name [TyVarBndr] [Con] [Name]-#else-#if __GLASGOW_HASKELL__ < 802-data DataInfo = DataInfo Cxt Name [TyVarBndr] [Con] Cxt-#else-data DataInfo = DataInfo Cxt Name [TyVarBndr] [Con] [DerivClause] -#endif-#endif  {-|   This is the @Q@-lifted version of 'abstractNewtype.@@ -47,17 +35,10 @@   @data@ declarations. -} abstractNewtype :: Info -> Maybe DataInfo-#if __GLASGOW_HASKELL__ < 800-abstractNewtype (TyConI (NewtypeD cxt name args constr derive))-    = Just (DataInfo cxt name args [constr] derive)-abstractNewtype (TyConI (DataD cxt name args constrs derive))-    = Just (DataInfo cxt name args constrs derive)-#else abstractNewtype (TyConI (NewtypeD cxt name args _ constr derive))     = Just (DataInfo cxt name args [constr] derive) abstractNewtype (TyConI (DataD cxt name args _ constrs derive))     = Just (DataInfo cxt name args constrs derive)-#endif abstractNewtype _ = Nothing  {-| This function provides the name and the arity of the given data@@ -68,9 +49,7 @@ normalCon (RecC constr args) = (constr, map (\(_,s,t) -> (s,t)) args, Nothing) normalCon (InfixC a constr b) = (constr, [a,b], Nothing) normalCon (ForallC _ _ constr) = normalCon constr-#if __GLASGOW_HASKELL__ >= 800 normalCon (GadtC (constr:_) args typ) = (constr,args,Just typ)-#endif normalCon _ = error "missing case for 'normalCon'"  normalCon' :: Con -> (Name,[Type], Maybe Type)@@ -126,16 +105,14 @@ abstractConType (RecC constr args) = (constr, length args) abstractConType (InfixC _ constr _) = (constr, 2) abstractConType (ForallC _ _ constr) = abstractConType constr-#if __GLASGOW_HASKELL__ >= 800 abstractConType (GadtC (constr:_) args _typ) = (constr,length args) -- Only first Name-#endif abstractConType _ = error "missing case for 'abstractConType'"  {-|   This function returns the name of a bound type variable -}-tyVarBndrName (PlainTV n) = n-tyVarBndrName (KindedTV n _) = n+tyVarBndrName (PlainTV n _) = n+tyVarBndrName (KindedTV n _ _) = n  containsType :: Type -> Type -> Bool containsType s t@@ -181,34 +158,19 @@     constraint. -} -#if __GLASGOW_HASKELL__ < 710-mkClassP :: Name -> [Type] -> Pred-mkClassP = ClassP-#else mkClassP :: Name -> [Type] -> Type mkClassP name = foldl AppT (ConT name)-#endif  {-| This function checks whether the given type constraint is an equality constraint. If so, the types of the equality constraint are returned. -} -#if __GLASGOW_HASKELL__ < 710-isEqualP :: Pred -> Maybe (Type, Type)-isEqualP (EqualP x y) = Just (x, y)-isEqualP _ = Nothing-#else isEqualP :: Type -> Maybe (Type, Type) isEqualP (AppT (AppT EqualityT x) y) = Just (x, y) isEqualP _ = Nothing-#endif  mkInstanceD :: Cxt -> Type -> [Dec] -> Dec-#if __GLASGOW_HASKELL__ < 800-mkInstanceD cxt ty decs = InstanceD cxt ty decs-#else mkInstanceD cxt ty decs = InstanceD Nothing cxt ty decs-#endif
src/Data/Comp/Desugar.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators         #-}
src/Data/Comp/Generic.hs view
@@ -38,7 +38,7 @@ getSubterm :: (Functor g, Foldable g) => [Int] -> Term g -> Maybe (Term g) getSubterm path t = cata alg t path where     alg :: (Functor g, Foldable g) => Alg g ([Int] -> Maybe (Cxt h g a))-    alg t [] = Just $ Term $ fmap ((fromJust) . ($[])) t+    alg t [] = Just $ Term $ fmap ((fromJust) . ($ [])) t     alg t (i:is) = case drop i (toList t) of                      [] -> Nothing                      x : _ -> x is
src/Data/Comp/Mapping.hs view
@@ -35,7 +35,7 @@ import Data.Traversable import Data.Foldable -import Control.Monad.State hiding (mapM)+import Control.Monad.State import Prelude hiding (mapM)
src/Data/Comp/Multi/Algebra.hs view
@@ -91,6 +91,8 @@   import Control.Monad+import Data.Kind+ import Data.Comp.Multi.HFunctor import Data.Comp.Multi.HTraversable import Data.Comp.Multi.Term@@ -164,7 +166,7 @@   -- | This type represents uniform signature function specification.-type SigFun f g = forall (a :: * -> *). f a :-> g a+type SigFun f g = forall (a :: Type -> Type). f a :-> g a  -- | This type represents context function. type CxtFun f g = forall h . SigFun (Cxt h f) (Cxt h g)@@ -229,7 +231,7 @@ hom f = simpCxt . f  -- | This type represents monadic signature functions.-type SigFunM m f g = forall (a :: * -> *) . NatM m (f a) (g a)+type SigFunM m f g = forall (a :: Type -> Type) . NatM m (f a) (g a)   -- | This type represents monadic context function.
src/Data/Comp/Multi/Derive/Equality.hs view
@@ -46,8 +46,8 @@               let n = length argts               varNs <- newNames n "x"               varNs' <- newNames n "y"-              let pat = ConP constr $ map VarP varNs-                  pat' = ConP constr $ map VarP varNs'+              let pat = ConP constr [] $ map VarP varNs+                  pat' = ConP constr [] $ map VarP varNs'                   vars = map VarE varNs                   vars' = map VarE varNs'                   mkEq ty x y = let (x',y') = (return x,return y)
src/Data/Comp/Multi/Derive/HFoldable.hs view
@@ -63,7 +63,7 @@             filterVar [d] x =Just (d, varE x)             filterVar _ _ =  error "functor variable occurring twice in argument type"             filterVars args varNs = catMaybes $ zipWith filterVar args varNs-            mkCPat constr args varNs = ConP constr $ zipWith mkPat args varNs+            mkCPat constr args varNs = ConP constr [] $ zipWith mkPat args varNs             mkPat [] _ = WildP             mkPat _ x = VarP x             mkPatAndVars (constr, args) =
src/Data/Comp/Multi/Derive/HFunctor.hs view
@@ -47,8 +47,9 @@             filterVar farg _ [depth] x = farg depth x             filterVar _ _ _ _ = error "functor variable occurring twice in argument type"             filterVars args varNs farg nonFarg = zipWith (filterVar farg nonFarg) args varNs-            mkCPat constr varNs = ConP constr $ map mkPat varNs+            mkCPat constr varNs = ConP constr [] $ map mkPat varNs             mkPat = VarP+            mkPatAndVars :: (Name, [[t]]) -> Q (Q Exp, Pat, (t -> Q Exp -> c) -> (Q Exp -> c) -> [c], Bool, [Q Exp], [(t, Name)])             mkPatAndVars (constr, args) =                 do varNs <- newNames (length args) "x"                    return (conE constr, mkCPat constr varNs,
src/Data/Comp/Multi/Derive/HTraversable.hs view
@@ -52,7 +52,7 @@             filterVar farg _ [depth] x = farg depth x             filterVar _ _ _ _ = error "functor variable occurring twice in argument type"             filterVars args varNs farg nonFarg = zipWith (filterVar farg nonFarg) args varNs-            mkCPat constr varNs = ConP constr $ map mkPat varNs+            mkCPat constr varNs = ConP constr [] $ map mkPat varNs             mkPat = VarP             mkPatAndVars (constr, args) =                 do varNs <- newNames (length args) "x"
src/Data/Comp/Multi/Derive/Ordering.hs view
@@ -56,8 +56,8 @@             genEqClause coArg (constr, args,gadtTy) = do               varXs <- newNames (length args) "x"               varYs <- newNames (length args) "y"-              let patX = ConP constr $ map VarP varXs-              let patY = ConP constr $ map VarP varYs+              let patX = ConP constr [] $ map VarP varXs+              let patY = ConP constr [] $ map VarP varYs               body <- eqDBody (getBinaryFArg coArg gadtTy) (zip3 varXs varYs args)               return $ Clause [patX, patY] (NormalB body) []             eqDBody :: Type -> [(Name, Name, Type)] -> ExpQ
src/Data/Comp/Multi/Derive/Show.hs view
@@ -62,7 +62,7 @@             genShowFClause fArg (constr, args, ty) = do               let n = length args               varNs <- newNames n "x"-              let pat = ConP constr $ map VarP varNs+              let pat = ConP constr [] $ map VarP varNs                   allVars = zipWith (filterFarg (getBinaryFArg fArg ty)) args varNs                   shows = listE $ map mkShow allVars                   conName = nameBase constr
src/Data/Comp/Multi/Derive/SmartConstructors.hs view
@@ -64,6 +64,6 @@                     ftype = foldl appT (conT tname) (map varT targs')                     constr = (conT ''(:<:) `appT` ftype) `appT` f                     typ = foldl appT (conT ''Cxt) [h, f, a, maybe i return miTp]-                    typeSig = forallT (map PlainTV vars) (sequence [constr]) typ+                    typeSig = forallT (map (\ v -> PlainTV v SpecifiedSpec) vars) (sequence [constr]) typ                 sigD sname typeSig               genSig _ _ _ _ _ = []
src/Data/Comp/Multi/Desugar.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators         #-} {-# LANGUAGE UndecidableInstances  #-}
src/Data/Comp/Multi/HFunctor.hs view
@@ -40,6 +40,7 @@      ) where  import Data.Functor.Compose+import Data.Kind  -- | The identity Functor. newtype I a = I {unI :: a} deriving (Functor, Foldable, Traversable)@@ -102,4 +103,4 @@ infixl 5 :.:  -- | This data type denotes the composition of two functor families.-data (:.:) f (g :: (* -> *) -> (* -> *)) (e :: * -> *) t = Comp (f (g e) t)+data (:.:) f (g :: (Type -> Type) -> (Type -> Type)) (e :: Type -> Type) t = Comp (f (g e) t)
src/Data/Comp/Multi/Mapping.hs view
@@ -30,6 +30,8 @@ import Data.Comp.Multi.HFunctor import Data.Comp.Multi.HTraversable +import Data.Kind+ import Control.Monad.State  import Data.IntMap (IntMap)@@ -57,7 +59,7 @@ infixr 0 &  -class Mapping m (k :: * -> *) | m -> k where+class Mapping m (k :: Type -> Type) | m -> k where     -- | left-biased union of two mappings.     (&) :: m v -> m v -> m v @@ -76,7 +78,7 @@     findWithDefault :: a -> k i -> m a -> a  -newtype NumMap (k :: * -> *) v = NumMap (IntMap v) deriving Functor+newtype NumMap (k :: Type -> Type) v = NumMap (IntMap v) deriving Functor  lookupNumMap :: a -> Int -> NumMap t a -> a lookupNumMap d k (NumMap m) = IntMap.findWithDefault d k m
src/Data/Comp/Multi/Ops.hs view
@@ -37,6 +37,8 @@   import Control.Monad+import Data.Kind+ import Data.Comp.Multi.HFoldable import Data.Comp.Multi.HFunctor import Data.Comp.Multi.HTraversable@@ -48,8 +50,8 @@   -- |Data type defining coproducts.-data (f :+: g) (h :: * -> *) e = Inl (f h e)-                               | Inr (g h e)+data (f :+: g) (h :: Type -> Type) e = Inl (f h e)+                                     | Inr (g h e)  {-| Utility function to case on a higher-order functor sum, without exposing the   internal representation of sums. -}@@ -88,15 +90,15 @@ infixl 5 :<: infixl 5 :=: -type family Elem (f :: (* -> *) -> * -> *)-                 (g :: (* -> *) -> * -> *) :: Emb where+type family Elem (f :: (Type -> Type) -> Type -> Type)+                 (g :: (Type -> Type) -> Type -> Type) :: Emb where     Elem f f = Found Here     Elem (f1 :+: f2) g =  Sum' (Elem f1 g) (Elem f2 g)     Elem f (g1 :+: g2) = Choose (Elem f g1) (Elem f g2)     Elem f g = NotFound -class Subsume (e :: Emb) (f :: (* -> *) -> * -> *)-                         (g :: (* -> *) -> * -> *) where+class Subsume (e :: Emb) (f :: (Type -> Type) -> Type -> Type)+                         (g :: (Type -> Type) -> Type -> Type) where   inj'  :: Proxy e -> f a :-> g a   prj'  :: Proxy e -> NatM Maybe (g a) (f a) @@ -158,12 +160,12 @@ -- signature. Alternatively, this could have also been defined as -- -- @--- data (f :&: a) (g ::  * -> *) e = f g e :&: a e+-- data (f :&: a) (g ::  Type -> Type) e = f g e :&: a e -- @ -- -- This is too general, however, for example for 'productHHom'. -data (f :&: a) (g ::  * -> *) e = f g e :&: a+data (f :&: a) (g ::  Type -> Type) e = f g e :&: a   instance (HFunctor f) => HFunctor (f :&: a) where@@ -184,13 +186,13 @@  -- | This class defines how to distribute an annotation over a sum of -- signatures.-class DistAnn (s :: (* -> *) -> * -> *) p s' | s' -> s, s' -> p where+class DistAnn (s :: (Type -> Type) -> Type -> Type) p s' | s' -> s, s' -> p where     -- | This function injects an annotation over a signature.     injectA :: p -> s a :-> s' a     projectA :: s' a :-> (s a O.:&: p)  -class RemA (s :: (* -> *) -> * -> *) s' | s -> s'  where+class RemA (s :: (Type -> Type) -> Type -> Type) s' | s -> s'  where     remA :: s a :-> s' a
src/Data/Comp/Multi/Projection.hs view
@@ -31,15 +31,17 @@ import Data.Comp.SubsumeCommon import Data.Comp.Multi.Ops hiding (Elem) -type family Elem (f :: * -> *)-                 (g :: * -> *) :: Emb where+import Data.Kind++type family Elem (f :: Type -> Type)+                 (g :: Type -> Type) :: Emb where     Elem f f = Found Here     Elem (f1 :*: f2) g =  Sum' (Elem f1 g) (Elem f2 g)     Elem f (g1 :*: g2) = Choose (Elem f g1) (Elem f g2)     Elem f g = NotFound -class Proj (e :: Emb) (p :: * -> *)-                      (q :: * -> *) where+class Proj (e :: Emb) (p :: Type -> Type)+                      (q :: Type -> Type) where     pr'  :: Proxy e -> q a -> p a  instance Proj (Found Here) f f where
src/Data/Comp/Multi/Term.hs view
@@ -36,13 +36,13 @@ import Data.Comp.Multi.HFunctor import Data.Comp.Multi.HTraversable -+import Data.Kind  import Control.Monad  import Unsafe.Coerce -type Const (f :: (* -> *) -> * -> *) = f (K ())+type Const (f :: (Type -> Type) -> Type -> Type) = f (K ())  -- | This function converts a constant to a term. This assumes that -- the argument is indeed a constant, i.e. does not have a value for
src/Data/Comp/Multi/Variables.hs view
@@ -47,8 +47,9 @@ import Data.Comp.Multi.HFunctor import Data.Comp.Multi.Mapping import Data.Comp.Multi.Ops- import Data.Comp.Multi.Term++import Data.Kind import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set)@@ -71,7 +72,7 @@ {-| This multiparameter class defines functors with variables. An instance   @HasVar f v@ denotes that values over @f@ might contain and bind variables of   type @v@. -}-class HasVars (f  :: (* -> *) -> * -> *) v where+class HasVars (f  :: (Type -> Type) -> Type -> Type) v where     -- | Indicates whether the @f@ constructor is a variable. The     -- default implementation returns @Nothing@.     isVar :: f a :=> Maybe v
src/Data/Comp/Ops.hs view
@@ -29,6 +29,7 @@  import Data.Foldable import Data.Traversable+import Data.Kind  import Control.Applicative import Control.Monad hiding (mapM, sequence)@@ -92,13 +93,13 @@ infixl 5 :<: infixl 5 :=: -type family Elem (f :: * -> *) (g :: * -> *) :: Emb where+type family Elem (f :: Type -> Type) (g :: Type -> Type) :: Emb where     Elem f f = Found Here     Elem (f1 :+: f2) g =  Sum' (Elem f1 g) (Elem f2 g)     Elem f (g1 :+: g2) = Choose (Elem f g1) (Elem f g2)     Elem f g = NotFound -class Subsume (e :: Emb) (f :: * -> *) (g :: * -> *) where+class Subsume (e :: Emb) (f :: Type -> Type) (g :: Type -> Type) where   inj'  :: Proxy e -> f a -> g a   prj'  :: Proxy e -> g a -> Maybe (f a)
src/Data/Comp/Projection.hs view
@@ -30,15 +30,17 @@  import Data.Comp.SubsumeCommon -type family Elem (f :: *)-                 (g :: *) :: Emb where+import Data.Kind++type family Elem (f :: Type)+                 (g :: Type) :: Emb where     Elem f f = Found Here     Elem (f1, f2) g =  Sum' (Elem f1 g) (Elem f2 g)     Elem f (g1, g2) = Choose (Elem f g1) (Elem f g2)     Elem f g = NotFound -class Proj (e :: Emb) (p :: *)-                      (q :: *) where+class Proj (e :: Emb) (p :: Type)+                      (q :: Type) where     pr'  :: Proxy e -> q -> p  instance Proj (Found Here) f f where
src/Data/Comp/Term.hs view
@@ -35,6 +35,7 @@ import Control.Applicative hiding (Const) import Control.Monad hiding (mapM, sequence) +import Data.Kind import Data.Foldable import Data.Traversable import Unsafe.Coerce@@ -58,7 +59,7 @@ second parameter is the signature of the context. The third parameter is the type of the holes. -} -data Cxt :: * -> (* -> *) -> * -> * where+data Cxt :: Type -> (Type -> Type) -> Type -> Type where             Term :: f (Cxt h f a) -> Cxt h f a             Hole :: a -> Cxt Hole f a @@ -104,7 +105,6 @@     (<*>) = ap  instance (Functor f) => Monad (Context f) where-    return = Hole     m >>= f = run m         where run (Hole v) = f v               run (Term t) = Term (fmap run t)
src/Data/Comp/Thunk.hs view
@@ -54,11 +54,6 @@ import Control.Monad hiding (mapM, sequence) import Data.Traversable --- Control.Monad.Fail import is redundant since GHC 8.8.1-#if !MIN_VERSION_base(4,13,0)-import Control.Monad.Fail (MonadFail)-#endif- import Prelude hiding (foldl, foldl1, foldr, foldr1, mapM, sequence)
src/Data/Comp/Unification.hs view
@@ -20,6 +20,7 @@ import Data.Comp.Term import Data.Comp.Variables +import Control.Monad import Control.Monad.Except import Control.Monad.State