syb-extras (empty) → 0.1
raw patch · 4 files changed
+261/−0 lines, 4 filesdep +basedep +prelude-extrassetup-changed
Dependencies added: base, prelude-extras
Files
- Data/Data/Extras.hs +198/−0
- LICENSE +30/−0
- Setup.lhs +7/−0
- syb-extras.cabal +26/−0
+ Data/Data/Extras.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE Rank2Types #-}+module Data.Data.Extras + ( Data1(..)+ , fromConstr1+ , fromConstrB1+ , fromConstrM1+ , fromConstr2+ , fromConstrB2+ , fromConstrM2+ , module Data.Data+ ) where++import Data.Data+import Data.Maybe+import Control.Monad++newtype ID x = ID { unID :: x }+newtype CONST c a = CONST { unCONST :: c }+data Qi q a = Qi { _qiCount :: Int , unQi :: Maybe q } +newtype Qr r a = Qr { unQr :: r -> r }+newtype Mp m x = Mp { unMp :: m (x, Bool) }++class Typeable1 f => Data1 f where+ gfoldl1 :: Data a => (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> f a -> c (f a)+ gfoldl1 _ z = z++ gunfold1 :: Data a => (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (f a)++ toConstr1 :: Data a => f a -> Constr++ dataTypeOf1 :: Data a => f a -> DataType++ dataCast1_1 :: (Typeable1 t, Data a) => (forall d. Data d => c (t d)) -> Maybe (c (f a))+ dataCast1_1 _ = Nothing++ dataCast2_1 :: (Typeable2 t, Data a) => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (f a))+ dataCast2_1 _ = Nothing++ gmapT1 :: Data a => (forall b. Data b => b -> b) -> f a -> f a + gmapT1 f x0 = unID (gfoldl1 (\(ID c) x -> ID (c (f x))) ID x0)++ gmapQl1 :: Data a => (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> f a -> r+ gmapQl1 o r f = unCONST . gfoldl1 (\c x -> CONST $ unCONST c `o` f x) (\_ -> CONST r)++ gmapQr1 :: Data a => (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> f a -> r+ gmapQr1 o r0 f x0 = unQr (gfoldl1 (\(Qr c) x -> Qr (\r -> c (f x `o` r))) (const (Qr id)) x0) r0++ gmapQ1 :: Data a => (forall d. Data d => d -> u) -> f a -> [u]+ gmapQ1 f = gmapQr1 (:) [] f++ gmapQi1 :: Data a => Int -> (forall d. Data d => d -> u) -> f a -> u+ gmapQi1 i f x = fromJust $ unQi $ gfoldl1 (\(Qi i' q) a -> Qi (i'+1) (if i==i' then Just (f a) else q))+ (\_ -> Qi 0 Nothing) + x+ + gmapM1 :: (Monad m, Data a) => (forall d. Data d => d -> m d) -> f a -> m (f a)+ gmapM1 f = gfoldl1 (\c x -> do c' <- c; liftM c' (f x)) return+ + gmapMp1 :: (MonadPlus m, Data a) => (forall d. Data d => d -> m d) -> f a -> m (f a)+ gmapMp1 f x = unMp (gfoldl1 k z x) >>= \(x',b) ->+ if b then return x' else mzero+ where+ z g = Mp (return (g,False))+ k (Mp c) y+ = Mp ( c >>= \(h, b) ->+ (f y >>= \y' -> return (h y', True))+ `mplus` return (h y, b)+ )++ gmapMo1 :: (MonadPlus m, Data a) => (forall d. Data d => d -> m d) -> f a -> m (f a)+ gmapMo1 f x = unMp (gfoldl1 k z x) >>= \(x',b) ->+ if b then return x' else mzero+ where+ z g = Mp (return (g,False))+ k (Mp c) y+ = Mp ( c >>= \(h,b) -> if b+ then return (h y, b)+ else (f y >>= \y' -> return (h y',True))+ `mplus` return (h y, b)+ )+ ++fromConstr1 :: (Data1 f, Data a) => Constr -> f a+fromConstr1 = fromConstrB1 undefined++fromConstrB1 :: (Data1 f, Data a) => (forall d. Data d => d) -> Constr -> f a+fromConstrB1 f = unID . gunfold1 (\c -> ID (unID c f)) ID++fromConstrM1 :: (Monad m, Data1 f, Data a) => (forall d. Data d => m d) -> Constr -> m (f a)+fromConstrM1 f = gunfold1 (\c -> ap c f) return++instance Data1 [] where+ gfoldl1 = gfoldl+ toConstr1 = toConstr+ gunfold1 = gunfold+ dataTypeOf1 = dataTypeOf+ dataCast1_1 f = gcast1 f+ +instance Data1 Maybe where+ gfoldl1 = gfoldl+ toConstr1 = toConstr+ gunfold1 = gunfold+ dataTypeOf1 = dataTypeOf+ dataCast1_1 f = gcast1 f+instance Data a => Data1 (Either a) where+ gfoldl1 = gfoldl+ toConstr1 = toConstr+ gunfold1 = gunfold+ dataTypeOf1 = dataTypeOf+ dataCast1_1 f = gcast1 f+instance Data a => Data1 ((,) a) where+ gfoldl1 = gfoldl+ toConstr1 = toConstr+ gunfold1 = gunfold+ dataTypeOf1 = dataTypeOf+ dataCast1_1 f = gcast1 f++class Typeable2 f => Data2 f where+ gfoldl2 :: (Data a, Data x) => (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> f a x -> c (f a x)+ gfoldl2 _ z = z++ gunfold2 :: (Data a, Data x) => (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (f a x)++ toConstr2 :: (Data a, Data x) => f a x -> Constr++ dataTypeOf2 :: (Data a, Data x) => f a x -> DataType++ dataCast1_2 :: (Typeable1 t, Data a, Data x) => (forall d. Data d => c (t d)) -> Maybe (c (f a x))+ dataCast1_2 _ = Nothing++ dataCast2_2 :: (Typeable2 t, Data a, Data x) => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (f a x))+ dataCast2_2 _ = Nothing++ gmapT2 :: (Data a, Data x) => (forall b. Data b => b -> b) -> f a x -> f a x+ gmapT2 f x0 = unID (gfoldl2 (\(ID c) x -> ID (c (f x))) ID x0)++ gmapQl2 :: (Data a, Data x) => (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> f a x -> r+ gmapQl2 o r f = unCONST . gfoldl2 (\c x -> CONST $ unCONST c `o` f x) (\_ -> CONST r)++ gmapQr2 :: (Data a, Data x) => (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> f a x -> r+ gmapQr2 o r0 f x0 = unQr (gfoldl2 (\(Qr c) x -> Qr (\r -> c (f x `o` r))) (const (Qr id)) x0) r0++ gmapQ2 :: (Data a, Data x) => (forall d. Data d => d -> u) -> f a x -> [u]+ gmapQ2 f = gmapQr2 (:) [] f++ gmapQi2 :: (Data a, Data x) => Int -> (forall d. Data d => d -> u) -> f a x -> u+ gmapQi2 i f x = fromJust $ unQi $ gfoldl2 (\(Qi i' q) a -> Qi (i'+2) (if i==i' then Just (f a) else q))+ (\_ -> Qi 0 Nothing) + x+ + gmapM2 :: (Monad m, Data a, Data x) => (forall d. Data d => d -> m d) -> f a x -> m (f a x)+ gmapM2 f = gfoldl2 (\c x -> do c' <- c; liftM c' (f x)) return+ + gmapMp2 :: (MonadPlus m, Data a, Data x) => (forall d. Data d => d -> m d) -> f a x -> m (f a x)+ gmapMp2 f x = unMp (gfoldl2 k z x) >>= \(x',b) ->+ if b then return x' else mzero+ where+ z g = Mp (return (g,False))+ k (Mp c) y+ = Mp ( c >>= \(h, b) ->+ (f y >>= \y' -> return (h y', True))+ `mplus` return (h y, b)+ )++ gmapMo2 :: (MonadPlus m, Data a, Data x) => (forall d. Data d => d -> m d) -> f a x -> m (f a x)+ gmapMo2 f x = unMp (gfoldl2 k z x) >>= \(x',b) ->+ if b then return x' else mzero+ where+ z g = Mp (return (g,False))+ k (Mp c) y+ = Mp ( c >>= \(h,b) -> if b+ then return (h y, b)+ else (f y >>= \y' -> return (h y',True))+ `mplus` return (h y, b)+ )+ +fromConstr2 :: (Data2 f, Data a, Data x) => Constr -> f a x+fromConstr2 = fromConstrB2 undefined++fromConstrB2 :: (Data2 f, Data a, Data x) => (forall d. Data d => d) -> Constr -> f a x+fromConstrB2 f = unID . gunfold2 (\c -> ID (unID c f)) ID++fromConstrM2 :: (Monad m, Data2 f, Data a, Data x) => (forall d. Data d => m d) -> Constr -> m (f a x)+fromConstrM2 f = gunfold2 (\c -> ap c f) return++instance Data2 Either where+ gfoldl2 = gfoldl+ toConstr2 = toConstr+ gunfold2 = gunfold+ dataTypeOf2 = dataTypeOf+ dataCast2_2 f = gcast2 f++instance Data2 (,) where+ gfoldl2 = gfoldl+ toConstr2 = toConstr+ gunfold2 = gunfold+ dataTypeOf2 = dataTypeOf+ dataCast2_2 f = gcast2 f
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright 2011 Edward Kmett++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ syb-extras.cabal view
@@ -0,0 +1,26 @@+name: syb-extras+category: Polymorphism, Combinators, Generic+version: 0.1+license: BSD3+cabal-version: >= 1.2+license-file: LICENSE+author: Edward A. Kmett+maintainer: Edward A. Kmett <ekmett@gmail.com>+stability: provisional+homepage: http://comonad.com/reader/+copyright: Copyright (C) 2011 Edward A. Kmett+synopsis: higher order versions of the Scrap Your Boilerplate classes+description: higher order versions of Scrap Your Boilerplate classes to ease programming with polymorphic recursion and reduce UndecidableInstances+build-type: Simple++library+ build-depends: + base >= 4 && < 4.4,+ prelude-extras >= 0.1 && < 0.3++ extensions: CPP++ ghc-options: -Wall ++ exposed-modules:+ Data.Data.Extras