traverse-with-class 0.2.0.4 → 1.0.0.0

raw patch · 9 files changed

+146/−87 lines, 9 filesdep +tastydep +tasty-hunitdep +traverse-with-classdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: tasty, tasty-hunit, traverse-with-class

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGES.md +7/−0
• Data/Generics/Traversable.hs +38/−50
• Data/Generics/Traversable/Core.hs +3/−5
• Data/Generics/Traversable/Instances.hs +2/−2
• Data/Generics/Traversable/TH.hs +8/−4
• Data/Generics/Traversable/Zipper.hs +6/−13
• Data/Proxy/Fork.hs +0/−8
• tests/test.hs +42/−0
• traverse-with-class.cabal +40/−5

@@ -1,6 +1,13 @@ Changes ======= +Version 1.0.0.0+---------------++Replace implicit parameters with explicit type application.++This drops support for GHCs older than 8.0.+ Version 0.2.0.4 --------------- 

@@ -1,28 +1,26 @@-{-# LANGUAGE ConstraintKinds, KindSignatures, MultiParamTypeClasses, RankNTypes, UndecidableInstances, ImplicitParams, ScopedTypeVariables, FlexibleContexts, FlexibleInstances, CPP #-}--#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE UndecidableSuperClasses #-}-#endif- -- | All of the functions below work only on «interesting» subterms. -- It is up to the instance writer to decide which subterms are -- interesting and which subterms should count as immediate. This can -- also depend on the context @c@. -- -- The context, denoted @c@, is a constraint (of kind @* -> Constraint@)--- that provides additional facilities to work with the data. Most--- functions take an implicit parameter @?c :: p c@; it's--- used to disambugate which context you are referring to. @p@ can be--- @Proxy@ from the @tagged@ package or any other suitable type--- constructor.+-- that provides additional facilities to work with the data.+-- In most cases, the context cannot be inferred automatically.+-- You need to provide it using the+-- <https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/glasgow_exts.html#visible-type-application type application syntax>: --+-- > gmap @Show f x+-- > everywhere @Typeable f x+--+-- etc.+-- -- For more information, see: -- -- [Scrap your boilerplate with class]--- <http://research.microsoft.com/en-us/um/people/simonpj/papers/hmap/>+-- <https://www.microsoft.com/en-us/research/publication/scrap-your-boilerplate-with-class/> -- -- [Generalizing generic fold]--- <http://ro-che.info/articles/2013-03-11-generalizing-gfoldl.html>+-- <http://ro-che.info/articles/2013-03-11-generalizing-gfoldl>  module Data.Generics.Traversable   (@@ -51,15 +49,10 @@ import Data.Monoid import Data.Functor.Identity import Data.Functor.Constant-import Data.Proxy.Fork  import Data.Generics.Traversable.Core import Data.Generics.Traversable.Instances () --- for documentation only-import Data.Foldable-import Data.Traversable- -- | 'Rec' enables \"deep traversals\". -- -- It is satisfied automatically when its superclass constraints are@@ -69,90 +62,85 @@  -- | Generic map over the immediate subterms gmap-  :: (GTraversable c a, ?c :: p c)+  :: forall c a . (GTraversable c a)   => (forall d . (c d) => d -> d)   -> a -> a-gmap f = runIdentity . gtraverse (Identity . f)+gmap f a = runIdentity (gtraverse @c (Identity . f) a)  -- | Generic monadic map over the immediate subterms gmapM-  :: (Monad m, GTraversable c a, ?c :: p c)+  :: forall c m a . (Monad m, GTraversable c a)   => (forall d . (c d) => d -> m d)   -> a -> m a-gmapM f = unwrapMonad . gtraverse (WrapMonad . f)+gmapM f = unwrapMonad . gtraverse @c (WrapMonad . f) --- | Generic monoidal fold over the immediate subterms (cf. 'foldMap' from--- "Data.Foldable")+-- | Generic monoidal fold over the immediate subterms (cf. 'Data.Foldable.foldMap') gfoldMap-  :: (Monoid r, GTraversable c a, ?c :: p c)+  :: forall c r a . (Monoid r, GTraversable c a)   => (forall d . (c d) => d -> r)   -> a -> r-gfoldMap f = getConstant . gtraverse (Constant . f)+gfoldMap f = getConstant . gtraverse @c (Constant . f)  -- | Generic right fold over the immediate subterms gfoldr-  :: (GTraversable c a, ?c :: p c)+  :: forall c a r . (GTraversable c a)   => (forall d . (c d) => d -> r -> r)   -> r -> a -> r-gfoldr f z t = appEndo (gfoldMap (Endo . f) t) z+gfoldr f z t = appEndo (gfoldMap @c (Endo . f) t) z  -- | Generic strict left fold over the immediate subterms gfoldl'-  :: (GTraversable c a, ?c :: p c)+  :: forall c a r . (GTraversable c a)   => (forall d . (c d) => r -> d -> r)   -> r -> a -> r-gfoldl' f z0 xs = gfoldr f' id xs z0+gfoldl' f z0 xs = gfoldr @c f' id xs z0   where f' x k z = k $! f z x  -- | Apply a transformation everywhere in bottom-up manner everywhere-  :: forall a c p .-     (Rec c a, ?c :: p c)+  :: forall c a .+     (Rec c a)   => (forall d. (Rec c d) => d -> d)   -> a -> a everywhere f =-  let ?c = Proxy :: Proxy (Rec c) in   let-    go :: forall a . Rec c a => a -> a-    go = f . gmap go+    go :: forall b . Rec c b => b -> b+    go = f . gmap @(Rec c) go   in go  -- | Apply a transformation everywhere in top-down manner everywhere'-  :: forall a c p .-     (Rec c a, ?c :: p c)+  :: forall c a .+     (Rec c a)   => (forall d. (Rec c d) => d -> d)   -> a -> a everywhere' f =-  let ?c = Proxy :: Proxy (Rec c) in   let-    go :: forall a . Rec c a => a -> a-    go = gmap go . f+    go :: forall b . Rec c b => b -> b+    go = gmap @(Rec c) go . f   in go  -- | Monadic variation on everywhere everywhereM-  :: forall m a c p .-     (Monad m, Rec c a, ?c :: p c)+  :: forall c m a .+     (Monad m, Rec c a)   => (forall d. (Rec c d) => d -> m d)   -> a -> m a everywhereM f =-  let ?c = Proxy :: Proxy (Rec c) in   let-    go :: forall a . Rec c a => a -> m a-    go = f <=< gmapM go+    go :: forall b . Rec c b => b -> m b+    go = f <=< gmapM @(Rec c) go   in go  -- | Strict left fold over all elements, top-down everything-  :: forall r a c p .-     (Rec c a, ?c :: p c)+  :: forall c r a .+     (Rec c a)   => (r -> r -> r)   -> (forall d . (Rec c d) => d -> r)   -> a -> r everything combine f =-  let ?c = Proxy :: Proxy (Rec c) in   let-    go :: forall a . Rec c a => a -> r-    go x = gfoldl' (\a y -> combine a (go y)) (f x) x+    go :: forall b . Rec c b => b -> r+    go x = gfoldl' @(Rec c) (\a y -> combine a (go y)) (f x) x   in go

@@ -1,22 +1,20 @@-{-# LANGUAGE ConstraintKinds, KindSignatures, MultiParamTypeClasses, RankNTypes, UndecidableInstances, ImplicitParams #-} module Data.Generics.Traversable.Core where  import GHC.Exts (Constraint)-import Control.Applicative  class GTraversable (c :: * -> Constraint) a where   -- | Applicative traversal over (a subset of) immediate subterms. This is-  -- a generic version of 'traverse' from "Data.Traversable".+  -- a generic version of 'Data.Traversable.traverse'.   --   -- The supplied function is applied only to the «interesting» subterms.   --   -- Other subterms are lifted using 'pure', and the whole structure is-  -- folded back using '<*>'.+  -- folded back using 'Control.Applicative.<*>'.   --   -- 'gtraverse' has a default implementation @const pure@, which works for   -- types without interesting subterms (in particular, atomic types).   gtraverse-    :: (Applicative f, ?c :: p c)+    :: (Applicative f)     => (forall d . c d => d -> f d)     -> a -> f a   gtraverse _ x = pure x

@@ -1,11 +1,11 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, ConstraintKinds, UndecidableInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-orphans #-} -- | This module defines 'GTraversable' instances for standard types -- exported by "Prelude" module Data.Generics.Traversable.Instances () where  import Data.Generics.Traversable.Core import Data.Generics.Traversable.TH-import Control.Applicative import Data.Ratio  instance GTraversable c ()

@@ -11,18 +11,19 @@ import Language.Haskell.TH import Control.Monad import Data.Generics.Traversable.Core-import Control.Applicative import Data.List +err :: String -> a err s = error $ "Data.Generics.Traversable.TH: " ++ s +getDataInfo :: Name -> Q (Name, [Name], [(Name, Int, [Type])]) getDataInfo name = do   info <- reify name   let     decl =       case info of         TyConI d -> d-        _ -> error ("can't be used on anything but a type constructor of an algebraic data type")+        _ -> err "can't be used on anything but a type constructor of an algebraic data type"    return $     case decl of@@ -39,7 +40,7 @@ -- data type. gtraverseExpr :: Name -> Q Exp gtraverseExpr typeName = do-  (typeName, typeParams, constructors) <- getDataInfo typeName+  (_name, _params, constructors) <- getDataInfo typeName   f <- newName "f"   x <- newName "x" @@ -76,7 +77,6 @@ -- >  gtraverse = $(gtraverseExpr ''MyType) deriveGTraversable :: Name -> Q [Dec] deriveGTraversable name = do-  info <- reify name   ctx <- newName "c"    (typeName, typeParams, constructors) <- getDataInfo name@@ -104,9 +104,13 @@    sequence [inst] +conA :: Con -> (Name, Int, [Type]) conA (NormalC c xs)   = (c, length xs, map snd xs) conA (InfixC x1 c x2) = conA (NormalC c [x1, x2]) conA (ForallC _ _ c)  = conA c conA (RecC c xs)      = (c, length xs, map (\(_,_,t)->t) xs)+conA _ = err "GADTs are not supported yet"++varName :: TyVarBndr -> Name varName (PlainTV n) = n varName (KindedTV n _) = n

@@ -60,9 +60,7 @@ -- Just 'd' -- -- So, unlike in @syz@, all of the list elements are siblings.-{-# LANGUAGE Rank2Types, GADTs, KindSignatures, ImplicitParams,-             ScopedTypeVariables, ConstraintKinds,-             MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE GADTs #-}  module Data.Generics.Traversable.Zipper (   -- * Core types@@ -90,13 +88,10 @@   setHole'   ) where -import Control.Monad ((<=<), MonadPlus, mzero, mplus, liftM)-import Data.Maybe (fromJust)+import Control.Monad (liftM) import Data.Generics.Traversable import Data.Typeable (Typeable, cast)-import Data.Proxy.Fork import GHC.Exts (Constraint)-import Control.Applicative  -- Core types @@ -143,9 +138,7 @@ unit = LeftCons (LeftUnit id)  toLeft :: forall a c . (Rec c a) => a -> Left c a-toLeft =-  let ?c = Proxy :: Proxy (Rec c) in-    gtraverse unit+toLeft = gtraverse @(Rec c) unit  fromLeft :: Left c r -> r fromLeft (LeftUnit a)   = a@@ -212,20 +205,20 @@  -- | Apply a generic query to the hole. query-  :: (forall a . Rec c a => a -> b)+  :: (forall d . Rec c d => d -> b)   -> Zipper c a -> b query f (Zipper hole _ctxt) = f hole  -- | Apply a generic transformation to the hole. trans-  :: (forall a . Rec c a => a -> a)+  :: (forall d . Rec c d => d -> d)   -> Zipper c a -> Zipper c a trans f (Zipper hole ctxt) = Zipper (f hole) ctxt  -- | Apply a generic monadic transformation to the hole transM   :: Monad m-  => (forall a . Rec c a => a -> m a)+  => (forall d . Rec c d => d -> m d)   -> Zipper c a -> m (Zipper c a) transM f (Zipper hole ctxt) = do   hole' <- f hole

@@ -1,8 +0,0 @@-{-# LANGUAGE ConstraintKinds, KindSignatures, PolyKinds #-}--- | In @tagged@, PolyKinds are enabled only starting with 7.6. Hence we--- have our own Proxy.-module Data.Proxy.Fork where--import GHC.Exts (Constraint)--data Proxy (c :: * -> Constraint) = Proxy

@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, ConstraintKinds, UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-}+import Test.Tasty+import Test.Tasty.HUnit+import Data.Generics.Traversable+import Data.Generics.Traversable.Zipper+import Data.Generics.Traversable.TH++data User a = User+ { name :: String+ , age  :: Int+ , misc :: a+ } deriving Show++alice :: User (Bool, Int)+alice = User "Alice" 22 (True, 12)++deriveGTraversable ''User++class U a+instance U a++main = defaultMain $ testGroup "Tests"+  [ testCase "size via gfoldl'" $+      gfoldl' @U (\a x -> a+1) 0 alice @?= 3+  , testCase "show immediate children via gfoldMap" $+      gfoldMap @Show (pure . show) alice @?= ["\"Alice\"","22","(True,12)"]+  , testCase "show all children via everything" $+      -- don't copy-paste this code; it's quadratic!+      everything @Show (++) (pure . show) alice @?=+        ["User {name = \"Alice\", age = 22, misc = (True,12)}","\"Alice\"","'A'","'l'","'i'","'c'","'e'","22","(True,12)","True","12"]+  , testCase "A zipper walk" $ do+      let z0 = toZipper @Show alice+      let Just z1 = down' z0 -- down' moves to the leftmost child+      query show z1 @?= "\"Alice\""+      let Just z2 = right z1+      query show z2 @?= "22"+      let Just z3 = down =<< right z2 -- down moves to the rightmost child+      query show z3 @?= "12"+      let Just z4 = left z3 -- down moves to the rightmost child+      query show z4 @?= "True"+  ]

@@ -1,8 +1,8 @@--- Initial traverse-with-class.cabal generated by cabal init.  For further +-- Initial traverse-with-class.cabal generated by cabal init.  For further -- documentation, see http://haskell.org/cabal/users-guide/  name:                traverse-with-class-version:             0.2.0.4+version:             1.0.0.0 synopsis:            Generic applicative traversals description:         This is a generic programming library in the spirit of                      \"Scrap your boilerplate with class\", but with several@@ -15,7 +15,6 @@ license-file:        LICENSE author:              Roman Cheplyaka maintainer:          Roman Cheplyaka <roma@ro-che.info>--- copyright:            category:            Data build-type:          Simple cabal-version:       >=1.10@@ -23,6 +22,10 @@   README.md   CHANGES.md +source-repository head+  type:     git+  location: https://github.com/feuerbach/traverse-with-class.git+ library   exposed-modules:     Data.Generics.Traversable                        Data.Generics.Traversable.TH@@ -30,7 +33,39 @@   other-modules:                        Data.Generics.Traversable.Core                        Data.Generics.Traversable.Instances-                       Data.Proxy.Fork-  build-depends:       base == 4.*, transformers, template-haskell+  build-depends:+                       -- we rely on TypeApplications and therefore only support GHC 8++                       -- you can use older versions of this package with older GHCs+                       base >= 4.9 && < 5,+                       transformers,+                       template-haskell   default-language:    Haskell2010+  default-extensions:  ConstraintKinds+                       KindSignatures+                       MultiParamTypeClasses+                       RankNTypes+                       UndecidableInstances+                       ScopedTypeVariables+                       FlexibleContexts+                       FlexibleInstances+                       TypeApplications+                       AllowAmbiguousTypes+                       UndecidableSuperClasses   other-extensions:    TemplateHaskell+  ghc-options:         -Wall+++test-suite test+  default-language:+    Haskell2010+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    tests+  main-is:+    test.hs+  build-depends:+      base+    , tasty >= 0.7+    , tasty-hunit+    , traverse-with-class