czipwith (empty) → 1.0.0.0
raw patch · 6 files changed
+333/−0 lines, 6 filesdep +basedep +czipwithdep +template-haskellsetup-changed
Dependencies added: base, czipwith, template-haskell, transformers
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- czipwith.cabal +51/−0
- src-test/Test.hs +47/−0
- src/Data/CZipWith.hs +198/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for czipwith++## 1.0.0.0 -- May 2017++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Lennart Spitzner++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Lennart Spitzner nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ czipwith.cabal view
@@ -0,0 +1,51 @@+name: czipwith+version: 1.0.0.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+ comes from the resemblance of its method to the regular+ zipWith function. The abstraction is useful for example+ for program config handling.+license: BSD3+license-file: LICENSE+author: Lennart Spitzner+maintainer: lsp@informatik.uni-kiel.de+copyright: Copyright (C) 2017 Lennart Spitzner+category: Data+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10+homepage: https://github.com/lspitzner/czipwith/+bug-reports: https://github.com/lspitzner/czipwith/issues++source-repository head+ type: git+ location: https://github.com/lspitzner/czipwith.git++library+ exposed-modules: Data.CZipWith+ -- other-modules: + -- other-extensions: + build-depends:+ { base >=4.7 && <4.10+ , template-haskell >=2.9 && <2.12+ }+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: {+ -Wall+ }++test-suite tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ buildable: True+ build-depends:+ { czipwith+ , base >=4.7 && <4.10+ , transformers >= 0.4.1.0 && <666+ -- no upper bound. The dep only gets used for old bases anyways+ }+ ghc-options: -Wall+ main-is: Test.hs+ hs-source-dirs: src-test
+ src-test/Test.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleInstances #-}++module Main where++++import Data.CZipWith+import Data.Functor.Identity++++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+ }++deriving instance Show (A Identity)+deriving instance Eq (A Identity)+++deriveCZipWith ''A+deriveCZipWith ''B++main :: IO ()+main = do+ let x1 = A (Identity "string") (Identity True)+ let x2 = A (Just "just") Nothing+ let x3 = cZipWith+ ( \x my -> case my of+ Nothing -> x+ Just y -> Identity y+ )+ x1+ x2+ errorIf (x3 /= A (Identity "just") (Identity True)) $ return ()++errorIf :: Bool -> a -> a+errorIf False = id+errorIf True = error "errorIf"
+ src/Data/CZipWith.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}++-- | A typeclass for an operation resembling 'zipWith' for types that are+-- parameterized over a constructor, plus template-haskell magic to+-- automatically derive instances.+--+-- @+-- zipWith :: (g -> h -> i ) -> [g] -> [h] -> [i]+-- cZipWith :: CZipWith k => (forall a . g a -> h a -> i a) -> k g -> k h -> k i+-- @+--+-- Types of the corresponding kind occur for example when handling program+-- configuration: When we define our an example configuration type like+--+-- @+-- data MyConfig f = MyConfig+-- { flag_foo :: f Bool+-- , flag_bar :: f Bool+-- , flag_someLimit :: f Int+-- }+-- @+--+-- then+--+-- * @MyConfig Maybe@ can be used as the result-type of parsing the+-- commandline or a configuration file; it includes the option that some+-- field was not specified;+-- * @MyConfig Identity@ can be used to represent both the default+-- configuration and the actual configuration derived from+-- defaults and the user input;+-- * @MyConfig (Const Text)@ type to represent documentation for our config,+-- to be displayed to the user.+--+-- This has the advantage that our configuration is defined in one place only,+-- so that changes are easy to make and we do not ever run into any internal+-- desynchonization of different datatypes. And once we obtained the final+-- 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+-- 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').+--+-- As an example for such usage, the+-- <https://github.com/lspitzner/brittany brittany> package uses this approach+-- together with using automatically-derived Semigroup-instances that allow+-- merging of config values (for example when commandline args do not override,+-- 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(..)+ , deriveCZipWith+ )+where++++import Language.Haskell.TH.Lib+import Language.Haskell.TH.Syntax++++-- | 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+-- <https://hackage.haskell.org/package/distributive distributive> package,+-- even when its method might not look similar to+-- those from @'Distributive'@. 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+-- > means that the holes in all values of that type, must have the same+-- > cardinality, fixed sized vectors, infinite streams, functions, etc.+-- > and no extra information to try to merge together.+--+-- Especially "all values of that type must have the same cardinality" is+-- true for instances of CZipWith, the only difference being that the "holes"+-- are instantiations of the @f :: * -> *@ to some type, where they are simply+-- @a :: *@ for @'Distributive'@.+--+-- For many @'Distributive'@ instances there are corresponding datatypes that+-- are instances of @'CZipWith'@ (although they do not seem particularly+-- 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 :)+-- data CStream a f = CStream (f a) (CStream a f) -- corresponding to an infinite stream+-- @+class CZipWith (k :: (* -> *) -> *) where+ -- | zipWith on constructors instead of values.+ 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++-- | Derives a 'CZipWith' 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 CZipWith 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+-- }+--+-- deriveCZipWith ''A+-- deriveCZipWith ''B+-- @+--+-- This produces the following instances:+--+-- @+-- instance CZipWith A where+-- 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)+-- @+deriveCZipWith :: Name -> DecsQ+deriveCZipWith 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 ->+ [|cZipWith $(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 $ appsE $ conE cons : params+ let funQ = funD 'cZipWith [clause pats body []]+ sequence [instanceD (cxt []) [t|CZipWith $(conT name)|] [funQ]]+ TyConI (DataD{}) ->+ error+ $ "datatype must have kind (* -> *) -> *!"+ ++ " (Found: "+ ++ show info+ ++ ")"+ _ ->+ error+ $ "name does not refer to a datatype!"+ ++ " (Found: "+ ++ show info+ ++ ")"+