czipwith 1.0.0.0 → 1.0.1.0

raw patch · 4 files changed

+313/−28 lines, 4 filesdep ~basedep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, template-haskell

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• czipwith.cabal +6/−6
• src-test/Test.hs +36/−4
• src/Data/CZipWith.hs +267/−18

@@ -1,5 +1,9 @@ # Revision history for czipwith +## 1.0.1.0  -- April 2018++* Add more classes: CFunctor, CPointed, CZipWithM+ ## 1.0.0.0  -- May 2017  * First version. Released on an unsuspecting world.

@@ -1,5 +1,5 @@ name:                czipwith-version:             1.0.0.0+version:             1.0.1.0 synopsis:            CZipWith class and deriving via TH description:         A typeclass similar to Data.Distributive, but for                      data parameterised with a type constructor. The name@@ -9,12 +9,12 @@ license:             BSD3 license-file:        LICENSE author:              Lennart Spitzner-maintainer:          lsp@informatik.uni-kiel.de+maintainer:          Lennart Spitzner <hexagoxel@hexagoxel.de> copyright:           Copyright (C) 2017 Lennart Spitzner category:            Data build-type:          Simple extra-source-files:  ChangeLog.md-cabal-version:       >=1.10+cabal-version:       1.18 homepage:            https://github.com/lspitzner/czipwith/ bug-reports:         https://github.com/lspitzner/czipwith/issues @@ -27,8 +27,8 @@   -- other-modules:          -- other-extensions:       build-depends:-    { base >=4.7 && <4.10-    , template-haskell >=2.9 && <2.12+    { base >=4.9 && <4.12+    , template-haskell >=2.9 && <2.14     }   hs-source-dirs:      src   default-language:    Haskell2010@@ -42,7 +42,7 @@   buildable:        True   build-depends:     { czipwith-    , base >=4.7 && <4.10+    , base >0 && <666     , transformers >= 0.4.1.0 && <666       -- no upper bound. The dep only gets used for old bases anyways     }

@@ -8,6 +8,7 @@  import Data.CZipWith import Data.Functor.Identity+import Data.Functor.Const   @@ -24,23 +25,54 @@  deriving instance Show (A Identity) deriving instance Eq (A Identity)+deriving instance Eq (A (Const Bool))+deriving instance Eq (A Maybe)+deriving instance Eq (B Identity)+deriving instance Eq (B (Const Bool))+deriving instance Eq (B Maybe)   deriveCZipWith ''A deriveCZipWith ''B +deriveCPointed ''A+deriveCPointed ''B++deriveCZipWithM ''A+deriveCZipWithM ''B+ main :: IO () main = do-  let x1 = A (Identity "string") (Identity True)-  let x2 = A (Just "just") Nothing+  let x1 =+        B (Identity 12) (Identity 3.1) (A (Identity "string") (Identity True))+  let x2 = B (Just 1) Nothing (A (Just "just") Nothing)   let x3 = cZipWith-        ( \x my -> case my of+        (\x my -> case my of           Nothing -> x           Just y  -> Identity y         )         x1         x2-  errorIf (x3 /= A (Identity "just") (Identity True)) $ return ()+  errorIf+      (x3 /= B (Identity 1) (Identity 3.1) (A (Identity "just") (Identity True))+      )+    $ return ()+  let (Identity x4) = cZipWithM+        (\x my -> Identity $ case my of+          Nothing -> x+          Just y  -> Identity y+        )+        x1+        x2+  errorIf+      (x4 /= B (Identity 1) (Identity 3.1) (A (Identity "just") (Identity True))+      )+    $ return ()+  let (Identity x5) = cTraverse Identity x2+  errorIf (x2 /= x5) $ return ()+  let x6 = cPoint (Const True)+  errorIf (x6 /= B (Const True) (Const True) (A (Const True) (Const True)))+    $ return ()  errorIf :: Bool -> a -> a errorIf False = id

@@ -3,12 +3,23 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DefaultSignatures #-} --- | A typeclass for an operation resembling 'zipWith' for types that are--- parameterized over a constructor, plus template-haskell magic to--- automatically derive instances.+-- | Lifted versions of the @'Functor'@, @'Pointed'@, @'Apply'@+-- and @'Traversable'@ classes, plus template-haskell magic to automatically+-- derive instances.+-- \"Lifted\" because these classes are about datatypes parameterized over a+-- constructor (i.e. of kind @(* -> *) -> *@). For example+-- @fmap :: (a -> b) -> f a -> f b@ becomes+-- @cMap :: (forall a . f a -> g a) -> c f -> c g@. --+-- For the lifted version of @Applicative@, we focus on 'liftA2' instead of+-- '\<*\>' as this is the only way to make the lifted version work. As a+-- consequence, the class and method are named after 'zipWith' because of+-- the similarity of the signatures and the semantics.+-- -- @+-- liftA2   :: Applicative f =>         (g   -> h   -> i  ) -> f g -> f h -> f i -- zipWith  ::                          (g   -> h   -> i  ) -> [g] -> [h] -> [i] -- cZipWith :: CZipWith k => (forall a . g a -> h a -> i a) -> k g -> k h -> k i -- @@@ -41,10 +52,12 @@ -- config @:: MyConfig Identity@, we don't have to think about @Nothing@ cases -- anymore. ----- The @'CZipWith'@ helps with this use-case, more specifically the merging of+-- @'cPointed'@ can initialize such polymorphic containers, and @'CZipWith'@+-- further helps with this use-case, more specifically the merging of -- input and default config: we can express the merging of user/default config -- @:: MyConfig Maybe -> MyConfig Identity -> MyConfig Identity@ in terms of--- @'cZipWith'@ (and get the implementation for free via 'deriveCZipWith').+-- @'cZipWith'@. The instances are simple boilerplate and thus can be realized+-- using the provided template-haskell. -- -- As an example for such usage, the -- <https://github.com/lspitzner/brittany brittany> package uses this approach@@ -53,27 +66,49 @@ -- but are added to those settings read from config file). See -- <https://github.com/lspitzner/brittany/blob/master/src/Language/Haskell/Brittany/Config/Types.hs the module containing the config type>. module Data.CZipWith-  ( CZipWith(..)+  ( CFunctor(..)+  , CPointed(..)+  , CZipWith(..)+  , CZipWithM(..)+  , cSequence+  , deriveCPointed   , deriveCZipWith+  , deriveCZipWithM   ) where   -import Language.Haskell.TH.Lib-import Language.Haskell.TH.Syntax+import           Data.Functor.Compose+import           Language.Haskell.TH.Lib+import           Language.Haskell.TH.Syntax  +-- | The "lifted Apply" class+class CPointed c where+  cPoint :: (forall a . f a) -> c f ++-- | The "lifted Functor" class+class CFunctor c where+  cMap :: (forall a . f a -> g a) -> c f -> c g+  default cMap :: CZipWith c => (forall a . f a -> g a) -> c f -> c g+  cMap f k = cZipWith (\x _ -> f x) k k++ -- | laws: -- -- * @'cZipWith' (\\x _ -> x) g _ = g@ -- * @'cZipWith' (\\_ y -> y) _ h = h@ ----- This class is morally related to the <https://hackage.haskell.org/package/distributive-0.5.2/docs/Data-Distributive.html#t:Distributive Distributive> class from the+-- This class seems to be some kind of "lifted" version of 'Applicative'+-- (or rather: of @'Apply'@),+-- but it also seems to share an important property with the+-- <https://hackage.haskell.org/package/distributive-0.5.2/docs/Data-Distributive.html#t:Distributive Distributive>+-- class from the -- <https://hackage.haskell.org/package/distributive distributive> package,--- even when its method might not look similar to--- those from @'Distributive'@. From the corresponding docs:+-- even when @'Distributive'@ and @'CZipWith'@ methods don't appear all that+-- similar. From the corresponding docs: -- -- > To be distributable a container will need to have a way to consistently -- > zip a potentially infinite number of copies of itself. This effectively@@ -91,9 +126,9 @@ -- useful..), for example: -- -- @--- newtype CUnit a f = CUnit (f a)                -- corresponding to 'Identity'--- data CPair a b f = CPair (f a) (f b)           -- corresponding to 'data MonoPair a = MonoPair a a'---                                                -- (the trivial fixed-size vector example :)+-- newtype CUnit a f = CUnit (f a)      -- corresponding to 'Identity'+-- data CPair a b f = CPair (f a) (f b) -- corresponding to 'data MonoPair a = MonoPair a a'+--                                      -- (Pair being a trivial fixed-size vector example) -- data CStream a f = CStream (f a) (CStream a f) -- corresponding to an infinite stream -- @ class CZipWith (k :: (* -> *) -> *) where@@ -101,9 +136,123 @@   cZipWith :: (forall a . g a -> h a -> i a) -> k g -> k h -> k i  -(<&>) :: Functor f => f a -> (a -> b) -> f b-(<&>) = flip fmap+-- | Where 'CZipWith' is a "lifted @Apply@", this is a "lifted 'Traversable'".+--+-- laws:+--+-- [/naturality/]+--   @t . 'cTraverse' f = 'cTraverse' (t . f)@+--   for every applicative transformation @t@+--+-- [/identity/]+--   @'cTraverse' Identity = Identity@+--+-- [/composition/]+--   @'cTraverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('cTraverse' g) . 'cTraverse' f@+--+-- and @cZipWithM f k l@ must behave like+-- @cTraverse getCompose (cZipWith (\x y -> Compose (f x y)) k l)@+-- +class CZipWith c => CZipWithM c where+  {-# MINIMAL cTraverse | cZipWithM #-} +  cTraverse :: Applicative m => (forall a . f a -> m (g a)) -> c f -> m (c g)+  cTraverse f k = cZipWithM (\x _ -> f x) k k+  cZipWithM :: Applicative m => (forall a . f a -> g a -> m (h a)) -> c f -> c g -> m (c h)+  cZipWithM f k l =+    cTraverse getCompose $ cZipWith (\x y -> Compose (f x y)) k l++-- | The equivalent of @'Traversable'@'s @'sequence'@/@'sequenceA'@+cSequence :: Applicative m => CZipWithM c => (c (Compose m f)) -> m (c f)+cSequence = cTraverse getCompose+++-- | Derives a 'cPointed' instance for a datatype of kind @(* -> *) -> *@.+--+-- Requires that for this datatype (we shall call its argument @f :: * -> *@ here)+--+-- * there is exactly one constructor;+-- * all fields in the one constructor are either of the form @f x@ for some+--   @x@ or of the form @X f@ for some type @X@ where there is an+--   @instance cPointed X@.+--+-- For example, the following would be valid usage:+--+-- @+-- data A f = A+--   { a_str  :: f String+--   , a_bool :: f Bool+--   }+--+-- data B f = B+--   { b_int   :: f Int+--   , b_float :: f Float+--   , b_a     :: A f+--   }+--+-- derivecPointed ''A+-- derivecPointed ''B+-- @+--+-- This produces the following instances:+--+-- @+-- instance cPointed A where+--   cPoint f = A f f+--+-- instance cPointed B where+--   cPoint f = B f f (cPoint f f)+-- @+deriveCPointed :: Name -> DecsQ+deriveCPointed name = do+  info <- reify name+  case info of+#if MIN_VERSION_template_haskell(2,11,0)+    TyConI (DataD _ _ [_tyvarbnd] _ [con] []) -> do+#else+    TyConI (DataD _ _ [_tyvarbnd] [con] []) -> do+#endif+      let (cons, elemTys) = case con of+            NormalC c tys -> (c, tys <&> \(_, t) -> t)+            RecC    c tys -> (c, tys <&> \(_, _, t) -> t)+            _ ->+              error+                $  "Deriving requires non-GADT, non-infix data type/record!"+                ++ " (Found: "+                ++ show con+                ++ ")"+      let tyvar = case _tyvarbnd of+            PlainTV n    -> n+            KindedTV n _ -> n+      let fQ   = mkName "f"+      let pats = [varP fQ]+      let+        params = elemTys <&> \ty -> case ty of+          AppT (VarT a1) _ | a1 == tyvar      -> varE fQ+          AppT ConT{} (VarT a2) | a2 == tyvar -> [|$(varE 'cPoint) $(varE fQ)|]+          _ ->+            error+              $ "All constructor arguments must have either type k a for some a or C k for some C (with instance CZip C)!"+              ++ " (Found: "+              ++ show ty+              ++ ")"+      let body = normalB $ appsE $ conE cons : params+      let funQ = funD 'cPoint [clause pats body []]+      sequence [instanceD (cxt []) [t|CPointed $(conT name)|] [funQ]]+    TyConI (DataD{}) ->+      error+        $  "datatype must have kind (* -> *) -> *!"+        ++ " (Found: "+        ++ show info+        ++ ")"+    _ ->+      error+        $  "name does not refer to a datatype!"+        ++ " (Found: "+        ++ show info+        ++ ")"++ -- | Derives a 'CZipWith' instance for a datatype of kind @(* -> *) -> *@. -- -- Requires that for this datatype (we shall call its argument @f :: * -> *@ here)@@ -138,8 +287,8 @@ --   cZipWith f (A x1 x2) (A y1 y2) = A (f x1 y1) (f x2 y2) -- -- instance CZipWith B where---   cZipWith f (B x1 x2 x3) (B y1 y2 y3)---     = B (f x1 y1) (f x2 y2) (cZipWith f x3 y3)+--   cZipWith f (B x1 x2 x3) (B y1 y2 y3) =+--     B (f x1 y1) (f x2 y2) (cZipWith f x3 y3) -- @ deriveCZipWith :: Name -> DecsQ deriveCZipWith name = do@@ -195,4 +344,104 @@         ++ " (Found: "         ++ show info         ++ ")"+++-- | Derives a 'CZipWithM' instance for a datatype of kind @(* -> *) -> *@.+--+-- Requires that for this datatype (we shall call its argument @f :: * -> *@ here)+--+-- * there is exactly one constructor;+-- * all fields in the one constructor are either of the form @f x@ for some+--   @x@ or of the form @X f@ for some type @X@ where there is an+--   @instance CZipWithM X@.+--+-- For example, the following would be valid usage:+--+-- @+-- data A f = A+--   { a_str  :: f String+--   , a_bool :: f Bool+--   }+--+-- data B f = B+--   { b_int   :: f Int+--   , b_float :: f Float+--   , b_a     :: A f+--   }+--+-- deriveCZipWithM ''A+-- deriveCZipWithM ''B+-- @+--+-- This produces the following instances:+--+-- @+-- instance CZipWithM A where+--   cZipWithM f (A x1 x2) (A y1 y2) = A \<$\> f x1 y1 \<*\> f x2 y2+--+-- instance CZipWith B where+--   cZipWithM f (B x1 x2 x3) (B y1 y2 y3) =+--     B \<$\> f x1 y1 \<*\> f x2 y2 \<*\> cZipWithM f x3 y3+-- @+deriveCZipWithM :: Name -> DecsQ+deriveCZipWithM name = do+  info <- reify name+  case info of+#if MIN_VERSION_template_haskell(2,11,0)+    TyConI (DataD _ _ [tyvarbnd] _ [con] []) -> do+#else+    TyConI (DataD _ _ [tyvarbnd] [con] []) -> do+#endif+      let (cons, elemTys) = case con of+            NormalC c tys -> (c, tys <&> \(_, t) -> t)+            RecC    c tys -> (c, tys <&> \(_, _, t) -> t)+            _ ->+              error+                $  "Deriving requires non-GADT, non-infix data type/record!"+                ++ " (Found: "+                ++ show con+                ++ ")"+      let tyvar = case tyvarbnd of+            PlainTV n    -> n+            KindedTV n _ -> n+      let fQ       = mkName "f"+      let indexTys = zip [1 ..] elemTys+      let indexTysVars = indexTys <&> \(i :: Int, ty) ->+            (ty, mkName $ "x" ++ show i, mkName $ "y" ++ show i)+      let dPat1     = conP cons $ indexTysVars <&> \(_, x, _) -> varP x+      let dPat2     = conP cons $ indexTysVars <&> \(_, _, x) -> varP x+      let pats      = [varP fQ, dPat1, dPat2]+      let+        params = indexTysVars <&> \(ty, x, y) -> case ty of+          AppT (VarT a1) _ | a1 == tyvar -> [|$(varE fQ) $(varE x) $(varE y)|]+          AppT ConT{} (VarT a2) | a2 == tyvar ->+            [|cZipWithM $(varE fQ) $(varE x) $(varE y)|]+          _ ->+            error+              $ "All constructor arguments must have either type k a for some a or C k for some C (with instance CZip C)!"+              ++ " (Found: "+              ++ show ty+              ++ ")"+      let body = normalB $ case params of+            [] -> [|pure $(conE cons)|]+            (p1:pr) -> foldl (\x p -> [|$x <*> $p|]) [|$(conE cons) <$> $p1|] pr+      let funQ = funD 'cZipWithM [clause pats body []]+      sequence [instanceD (cxt []) [t|CZipWithM $(conT name)|] [funQ]]+    TyConI (DataD{}) ->+      error+        $  "datatype must have kind (* -> *) -> *!"+        ++ " (Found: "+        ++ show info+        ++ ")"+    _ ->+      error+        $  "name does not refer to a datatype!"+        ++ " (Found: "+        ++ show info+        ++ ")"+++-- local utility, not worth an extra dependency+(<&>) :: Functor f => f a -> (a -> b) -> f b+(<&>) = flip fmap