haskus-utils-variant 2.0 → 2.0.1
raw patch · 3 files changed
+32/−22 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- haskus-utils-variant.cabal +3/−3
- src/lib/Haskus/Utils/EADT.hs +15/−10
- src/lib/Haskus/Utils/EADT/TH.hs +14/−9
haskus-utils-variant.cabal view
@@ -1,16 +1,16 @@ cabal-version: >=1.20 name: haskus-utils-variant-version: 2.0+version: 2.0.1 license: BSD3 license-file: LICENSE copyright: Sylvain Henry 2018 maintainer: sylvain@haskus.fr author: Sylvain Henry homepage: http://www.haskus.org-synopsis: Haskus utility modules+synopsis: Variant and EADT description: Variant (extensible sum type) and EADT (extensible recursive sum type)- datatypes.+ datatypes. Documentation can be found at https://docs.haskus.org category: System build-type: Simple
src/lib/Haskus/Utils/EADT.hs view
@@ -72,7 +72,10 @@ newtype VariantF (xs :: [* -> *]) e = VariantF (V (ApplyAll e xs)) --- | `ApplyAll e '[f,g,h] ==> '[f e, g e, h e]`+-- | Apply its first argument to every element of the 2nd arg list+--+-- > ApplyAll e '[f,g,h] ==> '[f e, g e, h e]+-- type family ApplyAll e (xs :: [* -> *]) :: [*] where ApplyAll e '[] = '[] ApplyAll e (f ': fs) = f e ': ApplyAll e fs@@ -173,14 +176,14 @@ -- modifying function. -- -- Usage:--- alterVariantF @NoConstraint id v--- alterVariantF @Resizable (resize 4) v -------- -- Multiple constraints:--- class (Ord a, Num a) => OrdNum a--- instance (Ord a, Num a) => OrdNum a--- alterVariantF @OrdNum foo v+-- > alterVariantF @NoConstraint id v+-- > alterVariantF @Resizable (resize 4) v+-- >+-- > -- Multiple constraints:+-- > class (Ord a, Num a) => OrdNum a+-- > instance (Ord a, Num a) => OrdNum a+-- > alterVariantF @OrdNum foo v -- alterVariantF :: forall c e (xs :: [* -> *]). ( AlterVariantF c e xs@@ -212,8 +215,10 @@ -- required by the modifying function. -- -- Usage:--- algVariantF @NoConstraint id v--- algVariantF @Resizable (resize 4) v+--+-- > algVariantF @NoConstraint id v+-- > algVariantF @Resizable (resize 4) v+-- algVariantF :: forall c e (xs :: [* -> *]). ( AlgVariantF c e xs ) => (forall (f :: * -> *). c f => f e -> e) -> VariantF xs e -> e
src/lib/Haskus/Utils/EADT/TH.hs view
@@ -50,9 +50,9 @@ -- > ====> -- > -- > pattern ConsList ::--- ( List a ~ EADT xs--- , ConsF a :<: xs--- ) => a -> List a -> List a+-- > ( List a ~ EADT xs+-- > , ConsF a :<: xs+-- > ) => a -> List a -> List a -- > pattern ConsList a l = VF (ConsF a l) -- -- Note that you have to quantify free variables explicitly with 'forall'@@ -106,6 +106,10 @@ -- [* -> *] tyToTyList = AppT ListT (AppT (AppT ArrowT StarT) StarT) + -- retreive functor var in "e"+ KindedTV e StarT = last tvs++ -- make pattern type (newTvs,eadtTy,ctx) <- do xsName <- newName "xs"@@ -115,21 +119,22 @@ eadtXs <- [t| EADT $(return xs) |] prd <- [t| $(return conTyp) :<: $(return xs) |]+ prd2 <- [t| $(return (VarT e)) ~ $(return eadtXs) |] case mEadtTy of- Nothing -> return ([xsTy],eadtXs,[prd])+ Nothing -> return ([xsTy],eadtXs,[prd,prd2]) Just ty -> do ty' <- ty let (tvs',ty'',ctx') = case ty' of+ -- put freevars of the user specified type with the+ -- other ones ForallT tvs'' ctx'' t -> (tvs'',t,ctx'') _ -> ([],ty',[])- prd2 <- [t| $(return ty'') ~ EADT $(return xs) |]- return (xsTy:tvs',ty'',prd:prd2:ctx')+ prd3 <- [t| $(return ty'') ~ $(return eadtXs) |]+ return (xsTy:tvs',ty'',prd:prd2:prd3:ctx') let -- remove functor var; add new type var- tvs' = init tvs ++ newTvs- -- retreive functor var in "e"- KindedTV e StarT = last tvs+ tvs' = tvs ++ newTvs -- replace functor variable with EADT type go (VarT x :->: b)