packages feed

traverse-with-class (empty) → 0.1

raw patch · 7 files changed

+360/−0 lines, 7 filesdep +basedep +template-haskelldep +transformerssetup-changed

Dependencies added: base, template-haskell, transformers

Files

+ Data/Generics/Traversable.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE ConstraintKinds, KindSignatures, MultiParamTypeClasses, RankNTypes, UndecidableInstances, ImplicitParams, ScopedTypeVariables #-}+-- | 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.+--+-- For more information, see:+--+-- [Scrap your boilerplate with class]+-- <http://research.microsoft.com/en-us/um/people/simonpj/papers/hmap/>+--+-- [Generalizing generic fold]+-- <http://ro-che.info/articles/2013-03-11-generalizing-gfoldl.html>++module Data.Generics.Traversable+  (+    -- * Open recursion combinators++    GTraversable(..)+  , gmap+  , gmapM+  , gfoldMap+  , gfoldr+  , gfoldl'++    -- * Closed recursion combinators+  , Rec+  , everywhere+  , everywhere'+  , everywhereM+  , everything+  )+  where++import GHC.Exts (Constraint)++import Control.Applicative+import Control.Monad+import Data.Monoid+import Data.Functor.Identity+import Data.Functor.Constant++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+-- satisfied — you are not supposed to declare new instances of this class.+class    (GTraversable (Rec c) a, c a) => Rec (c :: * -> Constraint) a+instance (GTraversable (Rec c) a, c a) => Rec (c :: * -> Constraint) a++-- | Generic map over the immediate subterms+gmap+  :: (GTraversable c a, ?c :: p c)+  => (forall d . (c d) => d -> d)+  -> a -> a+gmap f = runIdentity . gtraverse (Identity . f)++-- | Generic monadic map over the immediate subterms+gmapM+  :: (Monad m, GTraversable c a, ?c :: p c)+  => (forall d . (c d) => d -> m d)+  -> a -> m a+gmapM f = unwrapMonad . gtraverse (WrapMonad . f)++-- | Generic monoidal fold over the immediate subterms (cf. 'foldMap' from+-- "Data.Foldable")+gfoldMap+  :: (Monoid r, GTraversable c a, ?c :: p c)+  => (forall d . (c d) => d -> r)+  -> a -> r+gfoldMap f = getConstant . gtraverse (Constant . f)++-- | Generic right fold over the immediate subterms+gfoldr+  :: (GTraversable c a, ?c :: p c)+  => (forall d . (c d) => d -> r -> r)+  -> r -> a -> r+gfoldr f z t = appEndo (gfoldMap (Endo . f) t) z++-- | Generic strict left fold over the immediate subterms+gfoldl'+  :: (GTraversable c a, ?c :: p c)+  => (forall d . (c d) => r -> d -> r)+  -> r -> a -> r+gfoldl' f z0 xs = gfoldr f' id xs z0+  where f' x k z = k $! f z x++data Proxy (c :: * -> Constraint) = Proxy++-- | Apply a transformation everywhere in bottom-up manner+everywhere+  :: forall a c p .+     (Rec c a, ?c :: p c)+  => (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+  in go++-- | Apply a transformation everywhere in top-down manner+everywhere'+  :: forall a c p .+     (Rec c a, ?c :: p c)+  => (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+  in go++-- | Monadic variation on everywhere+everywhereM+  :: forall m a c p .+     (Monad m, Rec c a, ?c :: p c)+  => (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+  in go++-- | Strict left fold over all elements, top-down+everything+  :: forall r a c p .+     (Rec c a, ?c :: p c)+  => (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+  in go
+ Data/Generics/Traversable/Core.hs view
@@ -0,0 +1,22 @@+{-# 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".+  --+  -- The supplied function is applied only to the «interesting» subterms.+  --+  -- Other subterms are lifted using 'pure', and the whole structure is+  -- folded back using '<*>'.+  --+  -- 'gtraverse' has a default implementation @const pure@, which works for+  -- types without interesting subterms (in particular, atomic types).+  gtraverse+    :: (Applicative f, ?c :: p c)+    => (forall d . c d => d -> f d)+    -> a -> f a+  gtraverse = const pure
+ Data/Generics/Traversable/Instances.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, ConstraintKinds, UndecidableInstances #-}+-- | 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 ()+instance GTraversable c Bool+instance GTraversable c Int+instance GTraversable c Integer+instance GTraversable c Float+instance GTraversable c Double+instance GTraversable c (Ratio n)+instance GTraversable c Char+instance GTraversable c Ordering++deriveGTraversable ''Maybe+deriveGTraversable ''Either+deriveGTraversable ''(,)+deriveGTraversable ''(,,)++-- Uniform instance for lists+instance c a => GTraversable c [a] where+  gtraverse f = go where+    go [] = pure []+    go (x:xs) = (:) <$> f x <*> go xs+
+ Data/Generics/Traversable/TH.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE TemplateHaskell #-}+-- | For the generated instances you'll typically need the following+-- extensions:+--+-- >{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, ConstraintKinds, UndecidableInstances #-}+module Data.Generics.Traversable.TH+  ( deriveGTraversable+  , gtraverseExpr+  ) where++import Language.Haskell.TH+import Control.Monad+import Data.Generics.Traversable.Core+import Control.Applicative+import Data.List++err s = error $ "Data.Generics.Traversable.TH: " ++ s++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")++  return $+    case decl of+      DataD    _ n ps cs _ -> (n, map varName ps, map conA cs)+      NewtypeD _ n ps c  _ -> (n, map varName ps, [conA c])+      _ -> err ("not a data type declaration: " ++ show decl)++-- | Return a lambda expression which implements 'gtraverse' for the given+-- data type.+gtraverseExpr :: Name -> Q Exp+gtraverseExpr typeName = do+  (typeName, typeParams, constructors) <- getDataInfo typeName+  f <- newName "f"+  x <- newName "x"++  let+    lam = lamE [varP f, varP x] $ caseE (varE x) matches++    -- Con a1 ... -> pure Con <*> f a1 <*> ...+    mkMatch (c, n, _)+     = do args <- replicateM n (newName "arg")+          let+            applyF e arg =+              varE '(<*>) `appE` e `appE`+                (varE f `appE` varE arg)+            body = foldl applyF [| $(varE 'pure) $(conE c) |] args+          match (conP c $ map varP args) (normalB body) []+    matches = map mkMatch constructors++  lam++-- | Example usage:+--+-- >data MyType = MyType+-- >+-- >deriveGTraversable ''MyType+--+-- It tries to create the necessary instance constraints, but is not very+-- smart about it For tricky types, it may fail or produce an+-- overconstrained instance. In that case, write the instance declaration+-- yourself and use 'gtraverseExpr' to derive the implementation:+--+-- >data MyType a = MyType+-- >+-- >instance GTraversable (MyType a) where+-- >  gtraverse = $(gtraverseExpr ''MyType)+deriveGTraversable :: Name -> Q [Dec]+deriveGTraversable name = do+  info <- reify name+  ctx <- newName "c"++  (typeName, typeParams, constructors) <- getDataInfo name++  let+    appliedType = foldl AppT (ConT typeName) $ map VarT typeParams++    -- instance (...) => GTraversable ctx MyType where { ... }+    inst =+      instanceD context (conT ''GTraversable `appT` varT ctx `appT` pure appliedType) [ do+          -- gtraverse = ...+          funD 'gtraverse [ clause [] (normalB $ gtraverseExpr typeName) [] ]+        ]++    context = sequence userContext++    types = nub [ t | (_,_,ts) <- constructors, t <- ts ]++    userContext = [ classP ctx [pure t] | t <- types ]++  sequence [inst]++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)+varName (PlainTV n) = n+varName (KindedTV n _) = n
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2013 Roman Cheplyaka++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ traverse-with-class.cabal view
@@ -0,0 +1,30 @@+-- 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.1+synopsis:            Generic applicative traversals+description:         This is a generic programming library in the spirit of+                     \"Scrap your boilerplate with class\", but with several+                     improvements — most notably, it's based on the @gtraverse@+                     function instead of @gfoldl@.++                     @gtraverse@ is equivalent in power to @gfoldl@, but lets+                     you more easily write non-standard views of the data type.+license:             MIT+license-file:        LICENSE+author:              Roman Cheplyaka+maintainer:          Roman Cheplyaka <roma@ro-che.info>+-- copyright:           +category:            Data+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Data.Generics.Traversable+                       Data.Generics.Traversable.TH+  other-modules:+                       Data.Generics.Traversable.Core+                       Data.Generics.Traversable.Instances+  build-depends:       base == 4.*, transformers, template-haskell+  default-language:    Haskell2010