packages feed

derive 0.1.1 → 0.1.2

raw patch · 16 files changed

+247/−61 lines, 16 filesdep +sybdep ~basenew-uploader

Dependencies added: syb

Dependency ranges changed: base

Files

Data/Derive/All.hs view
@@ -3,6 +3,7 @@ module Data.Derive.All (module D) where  import Data.Derive.Arbitrary        as D+import Data.Derive.Arbitrary2       as D import Data.Derive.Binary           as D import Data.Derive.BinaryDefer      as D import Data.Derive.BinaryOld        as D
Data/Derive/Arbitrary.hs view
@@ -51,7 +51,15 @@     "Arbitrary")) tdat)) (dataVars dat))])) (head [(AppT (ConT (mkName     "Arbitrary")) (lK (dataName dat) (dataVars dat)))])[(ValD (VarP (mkName     "arbitrary")) (NormalB (DoE [(BindS (VarP (mkName "x")) (AppE (VarE (mkName-    "choose")) (TupE [(LitE (IntegerL 0)),(LitE (IntegerL (toInteger (length (+    "choose")) (TupE [+-- NOTE BIG TIME:+    (SigE (LitE (IntegerL 0)) (ConT (mkName "Int")))+-- The above was generated by the 'guess' function to just be+-- (LitE (IntegerL 0)) ...+-- but we must annotate it with an Int type so that auto-generated+-- instances actually work since otherwise we get an ambiguous type+-- freak-out+    ,(LitE (IntegerL (toInteger (length (     dataCtors dat) - 1))))]))),(NoBindS (CaseE (VarE (mkName "x")) ((map (\(     ctorInd,ctor) -> (Match (LitP (IntegerL ctorInd)) (NormalB (DoE ((map (     \field -> (BindS (VarP (mkName ("x" ++ show field))) (VarE (mkName
Data/Derive/Arbitrary2.hs view
@@ -1,12 +1,12 @@ {-# OPTIONS_GHC -fth -fno-warn-missing-methods -cpp #-} --- | Derivation for 'Test.QuickCheck.Arbitrary'.+-- | Derivation for 'Test.QuickCheck.Arbitrary' (version 2 of quickcheck.) -- -- * The resulting instances of @arbitrary@ generate each constructor -- of the data type with equal probability. -- -- * No form of size control is used.-module Data.Derive.Arbitrary2(makeArbitrary) where+module Data.Derive.Arbitrary2(makeArbitrary2) where  import Language.Haskell.TH.All @@ -16,7 +16,7 @@ import Test.QuickCheck import Data.DeriveGuess -example = (,) "Arbitrary" [d|+example = (,) "Arbitrary2" [d|      instance Arbitrary a => Arbitrary (DataName a) where         arbitrary = do@@ -35,13 +35,21 @@  #endif -makeArbitrary :: Derivation-makeArbitrary = derivation arbitrary' "Arbitrary"+makeArbitrary2 :: Derivation+makeArbitrary2 = derivation arbitrary' "Arbitrary2" arbitrary' dat = [InstanceD (concat ([(map (\tdat -> (AppT (ConT (mkName      "Arbitrary")) tdat)) (dataVars dat))])) (head [(AppT (ConT (mkName      "Arbitrary")) (lK (dataName dat) (dataVars dat)))])[(ValD (VarP (mkName      "arbitrary")) (NormalB (DoE [(BindS (VarP (mkName "x")) (AppE (VarE (mkName-    "choose")) (TupE [(LitE (IntegerL 0)),(LitE (IntegerL (toInteger (length (+    "choose")) (TupE [+-- NOTE BIG TIME:+    (SigE (LitE (IntegerL 0)) (ConT (mkName "Int")))+-- The above was generated by the 'guess' function to just be+-- (LitE (IntegerL 0)) ...+-- but we must annotate it with an Int type so that auto-generated+-- instances actually work since otherwise we get an ambiguous type+-- freak-out+    ,(LitE (IntegerL (toInteger (length (     dataCtors dat) - 1))))]))),(NoBindS (CaseE (VarE (mkName "x")) ((map (\(     ctorInd,ctor) -> (Match (LitP (IntegerL ctorInd)) (NormalB (DoE ((map (     \field -> (BindS (VarP (mkName ("x" ++ show field))) (VarE (mkName
Data/Derive/Data.hs view
@@ -2,8 +2,7 @@  -- | Derivation for the 'Data.Generics.Basics.Data' class, as -- described in the Scrap Your Boilerplate paper.  No type structure--- is abstracted; only gfoldl is implemented (notably, gunfold is--- not).+-- is abstracted  module Data.Derive.Data(makeData) where @@ -24,19 +23,78 @@         gfoldl k r (CtorOne x1) = r CtorOne `k` x1         gfoldl k r (CtorTwo x1 x2) = r CtorTwo `k` x1 `k` x2         gfoldl k r (CtorTwo' x1 x2) = r CtorTwo' `k` x1 `k` x2-     |]  #endif +{- GHC autogenerated instance:+instance (Data a, Data b) => Data (T a b) where+     gfoldl k z (C1 a b) = z C1 `k` a `k` b+     gfoldl k z C2       = z C2++     gunfold k z c = case constrIndex c of+                         1 -> k (k (z C1))+                         2 -> z C2++     toConstr (C1 _ _) = con_C1+     toConstr C2       = con_C2++     dataTypeOf _ = ty_T++ con_C1 = mkConstr ty_T "C1" [] Prefix+ con_C2 = mkConstr ty_T "C2" [] Prefix+ ty_T   = mkDataType "Module.T" [con_C1, con_C2]+-}+ makeData :: Derivation-makeData = derivation data' "Data"+makeData = derivation genDataInst "Data" -data' dat = [instance_context ["Data","Typeable"] "Data" dat [FunD (mkName-    "gfoldl") ((map (\(ctorInd,ctor) -> (Clause [(VarP (mkName "k")),(VarP (-    mkName "r")),(ConP (mkName (ctorName ctor)) ((map (\field -> (VarP (mkName-    ("x" ++ show field)))) (id [1..ctorArity ctor]))++[]))] (NormalB (-    foldr1With (VarE (mkName "k")) ((map (\field -> (VarE (mkName ("x" ++ show-    field)))) (reverse [1..ctorArity ctor]))++[(AppE (VarE (mkName "r")) (ConE-    (mkName (ctorName ctor))))]++[]))) [])) (id (zip [0..] (dataCtors dat))))++-    [])]]+genDataInst :: DataDef -> [Dec]+genDataInst dat = [+      instance_context ["Data","Typeable"] "Data" dat +      [ FunD (mkName "gfoldl") (gfoldlDefs dat),+        FunD (mkName "gunfold") (gunfoldDefs dat),+        FunD (mkName "toConstr") (toConstrDefs dat),+        FunD (mkName "dataTypeOf") (dataTypeOfDefs dat) ]+    ]+toConstrDefs :: DataDef -> [Clause]+toConstrDefs dat = map toConstrImpl (zip [(1::Integer)..] (dataCtors dat)) where+    toConstrImpl (ctorInd,ctor) = Clause [toConstrParams ctor] (toConstrDef ctorInd ctor) []+    toConstrParams ctor = AsP (mkName "ctor") (matchConstructor ctor)+    toConstrDef ind _ctor = NormalB $ +        app (varExpr "indexConstr")+            [ AppE  (varExpr "dataTypeOf") (varExpr "ctor"), lit ind ]+dataTypeOfDefs :: DataDef -> [Clause]+dataTypeOfDefs dat = [Clause dtOfParams dtOfDef dtOfClauses] where+    dtOfParams = [WildP]+    dtOfDef = NormalB $ varExpr "ty_T"+    dtOfClauses = (mkDt (dataCtors dat)) : map mkCon (zip [(1::Integer)..] (dataCtors dat))+    mkCon (ix,ctor) = FunD (mkName $ "con_C"++show ix) [Clause [] (NormalB (mkConImpl ix ctor)) []] +    mkConImpl _ix ctor = app (varExpr "mkConstr") +        [varExpr "ty_T", lit (ctorName ctor), ListE (fields ctor), ConE (mkName "Prefix") ]+    fields = map lit . ctorFields+    mkDt ctors = FunD (mkName "ty_T") [Clause [] (NormalB (mkDtImpl ctors)) []]+    mkDtImpl ctors = app (varExpr "mkDataType") [lit (show$ qualifiedDataName dat) , mkConVars ctors]+    mkConVars ctors = ListE $ map (\ix -> varExpr ("con_C"++show ix)) [(1::Int)..(length ctors)]+gfoldlDefs :: DataDef -> [Clause]+gfoldlDefs dat = map gfoldlImpl (zip [(1::Integer)..] (dataCtors dat)) where+    gfoldlImpl (_ctorInd,ctor) = Clause (gfoldlParams ctor) (gfoldlDef ctor) []+    gfoldlParams ctor = [ VarP (mkName "k"), VarP (mkName "r"), matchConstructor ctor ]+    gfoldlDef ctor = NormalB $ foldr1With (varExpr "k") foldFields where+        foldFields =    map (\field -> (varExpr ("x" ++ show field))) (reverse [1..ctorArity ctor])+                     ++ [ (AppE (varExpr "r") (ConE (mkName (ctorName ctor)))) ]+gunfoldDefs :: DataDef -> [Clause]+gunfoldDefs dat = [Clause guParams (NormalB guDef) []] where+    guParams = map (VarP . mkName) ["k","z","c"]+    guDef     = CaseE (AppE (varExpr "constrIndex") (varExpr "c")) $+                  map (guCase) (zip [(1::Integer)..] (dataCtors dat))+    guCase (ix,ctor) = Match (LitP (IntegerL ix)) (NormalB$ guCaseBody ctor) []+    guCaseBody ctor = foldr (\_ e -> AppE (varExpr "k") e)+                           (AppE (varExpr "z") (ConE . mkName . ctorName $ ctor))+                           [1..ctorArity ctor]+varExpr :: String -> Exp+varExpr = VarE . mkName+matchConstructor :: CtorDef -> Pat+matchConstructor ctor = ConP (mkName (ctorName ctor)) (fields++[]) where+    fields = map (\field -> (VarP (mkName ("x" ++ show field))))+                 (id [1..ctorArity ctor])
Data/Derive/Foldable.hs view
@@ -10,21 +10,23 @@  -- NOTE: Cannot be guessed as it relies on type information -module Data.Derive.Foldable(makeFoldable) where+module Data.Derive.Foldable(makeFoldable, makeFoldableN) where  import Language.Haskell.TH.All import Data.DeriveTraversal   makeFoldable :: Derivation-makeFoldable = derivation derive "Foldable"+makeFoldable = makeFoldableN 1 -derive dat = traversalInstance1 foldrTraversal "Foldable" dat+makeFoldableN :: Int -> Derivation+makeFoldableN n = traversalDerivation1 foldrTraversal{traversalArg = n} "Foldable"  foldrTraversal = defaultTraversalType         { traversalName   = "foldr"         , traversalFunc   = \n a -> l1 "flip" (l1 n a)         , traversalPlus   = fail "variable used in multiple positions in a data type"+        , traversalId     = l1 "flip" (l0 "const")         , traverseTuple   =         foldr (.:) id'         , traverseCtor    = const $ foldr (.:) id'         , traverseFunc    = \pat rhs -> sclause [vr "f", vr "b", pat] (AppE rhs (vr "b"))
Data/Derive/Functor.hs view
@@ -12,16 +12,17 @@  -- | Derives 'Functor', as discussed on the Haskell-prime mailing list: -- <http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html>.-module Data.Derive.Functor(makeFunctor) where+module Data.Derive.Functor(makeFunctor,makeFunctorN) where  import Language.Haskell.TH.All import Data.DeriveTraversal   makeFunctor :: Derivation-makeFunctor = derivation derive "Functor"+makeFunctor = makeFunctorN 1 -derive dat = traversalInstance1 functorTraversal "Functor" dat+makeFunctorN :: Int -> Derivation+makeFunctorN n = traversalDerivation1 functorTraversal{traversalArg = n} "Functor"  functorTraversal = defaultTraversalType         { traversalName   = "fmap"@@ -32,7 +33,7 @@ functorForArrowType :: Exp -> Exp -> Exp functorForArrowType a b   | isId a && isId b  =  id'-  | isId a            =  InfixE Nothing  (l0 ".") (Just b)-  | isId b            =  InfixE (Just a) (l0 ".") Nothing-  | otherwise         =  LamE [l0 "arg"] $ a .: l0 "arg" .: b+  | isId a            =  InfixE (Just b) (l0 ".") Nothing+  | isId b            =  InfixE Nothing  (l0 ".") (Just a)+  | otherwise         =  LamE [l0 "arg"] $ b .: l0 "arg" .: a  where isId = (id'==)
Data/Derive/Traversable.hs view
@@ -10,22 +10,23 @@  -- NOTE: Cannot be guessed as it relies on type information -module Data.Derive.Traversable(makeTraversable) where+module Data.Derive.Traversable(makeTraversable, makeTraversableN) where  import Language.Haskell.TH.All import Data.DeriveTraversal   makeTraversable :: Derivation-makeTraversable = derivation derive "Traversable"+makeTraversable = makeTraversableN 1 -derive dat = traversalInstance1 traverseTraversal "Traversable" dat+makeTraversableN :: Int -> Derivation+makeTraversableN n = traversalDerivation1 traverseTraversal{traversalArg = n} "Traversable"  traverseTraversal = defaultTraversalType         { traversalName  = "traverse"         , traversalId    = l0 "pure"         , traversalPlus  = fail "variable used in multiple positions in a data type"-        , traverseTuple  = \args -> liftAN (VarE $ tupleDataName $ length args) args+        , traverseTuple  = \args -> liftAN (ConE $ tupleDataName $ length args) args         , traverseCtor   = \ctor -> liftAN (l0 ctor)         , traverseFunc   = \pat rhs -> sclause [vr "f", pat] rhs         }
Data/Derive/Typeable.hs view
@@ -48,7 +48,7 @@  makeTypeable :: Derivation makeTypeable = derivation typeable' "Typeable"-typeable' dat = (funN nam [sclause [] (l1 "mkTyCon" $ lit $ dataName dat)])+typeable' dat = (funN nam [sclause [] (l1 "mkTyCon" $ lit . show $ qualifiedDataName dat)])                 : map f [0..dataArity dat]     where         nam = [if x == '.' then '_' else x | x <- "typename_" ++ dataName dat]
Data/DeriveTH.hs view
@@ -3,12 +3,13 @@ -- threading issues such that all one needs to do is: -- -- @---   data Foo = Foo ; $( derive 'Data.Derive.StdDerivations.eq' ''Foo )+--   data Foo = Foo ; $( derive makeEq ''Foo ) -- @ module Data.DeriveTH        (derive,         -- * Convienience re-exports         Derivation, -- abstract!+        module Data.Derive.All,         -- * Internal         _derive_string_instance        ) where@@ -16,6 +17,7 @@ import Data.List import Control.Monad (liftM) +import Data.Derive.All import Language.Haskell.TH.All  @@ -37,7 +39,7 @@ -- | Extract a 'DataDef' value from a type using the TH 'reify' -- framework. deriveOne :: Name -> Q DataDef-deriveOne x = liftM extract (reify x)+deriveOne x = extract =<< reify x -extract (TyConI decl) = normData decl+extract (TyConI decl) = liftM normData (expandData decl) extract _ = error $ "Data.Derive.TH.deriveInternal: not a type!"
Data/DeriveTraversal.hs view
@@ -14,6 +14,7 @@ -- <http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html>.
 module Data.DeriveTraversal(         TraveralType(..), defaultTraversalType,+        traversalDerivation1,         traversalInstance, traversalInstance1,         deriveTraversal     ) where@@ -78,6 +79,12 @@  --------------------------------------------------------------------------------- -- Deriving traversals
+++-- | Derivation for a Traversable like class with just 1 method+traversalDerivation1 :: TraveralType -> String -> Derivation+traversalDerivation1 tt nm = derivation (traversalInstance1 tt nm) (className (traversalArg tt))+    where className n = nm ++ (if n > 1 then show n else "")   -- | Instance for a Traversable like class with just 1 method
Derive.hs view
@@ -110,7 +110,7 @@ dropAppend xs = f 0 xs     where         f i ys | appendMsg `isPrefixOf` ys =-                if hashString rest == chk+                if hashString (filter (/= '\r') rest) == chk                 then f i []                 else (ys ++ "\n\n\n\n", True)             where (chk, rest) = span isDigit $ drop (length appendMsg) ys@@ -122,8 +122,11 @@         add c ~(cs,b) = (c:cs,b)  +-- note: need to be careful that on Windows we don't convert \n files into+--       \r\n files mainFile :: [Flag] -> FilePath -> IO () mainFile flags file = do+    file <- canonicalizePath file     (fileflags,pragmas,modname,datas,reqs) <- parseFile flags file     let devs = ["'\\n': $( _derive_string_instance make" ++ cls ++ " ''" ++ ctor ++ " )"                | (ctor,cls) <- reqs]@@ -134,8 +137,8 @@                    "import Data.DeriveTH\n" ++                    "import Data.Derive.All\n" ++                    datas ++ "\n" ++-                   "main = writeFile " ++ show x ++ " $\n" ++-                   "    unlines [" ++ concat (intersperse ", " devs) ++ "]\n"+                   "main = Prelude.writeFile " ++ show x ++ " $\n" +++                   "    Prelude.unlines [" ++ concat (intersperse ", " devs) ++ "]\n"      -- note: Wrong on Hugs on Windows     tmpdir <- getTemporaryDirectory@@ -149,23 +152,27 @@     hPutStr hshndl $ hscode txfile     hClose hshndl -    system $ "ghc -e " ++ modname ++ ".main " ++ hsfile--    txhandl <- openFile txfile ReadMode-    res <- hGetContents txhandl-    length res `seq` return ()-    hClose txhandl+    let incdir = dropTrailingPathSeparator $ joinPath $ reverse $+                 drop (1 + length (filter (== '.') modname)) $ reverse $ splitPath file+        cmd = "ghc -i. -i\"" ++ incdir ++ "\" -e " ++ modname ++ ".main " ++ hsfile+    code <- system cmd+    when (code /= ExitSuccess) $ do+        putStrLn "Failed to generate the code"+        exitWith code +    res <- readFile' txfile     when (KeepTemp `notElem` flags) $ do         removeFile hsfile         removeFile txfile      flgs <- return $ fileflags ++ flags     if Append `elem` flgs then do-        src <- readFile file+        src <- readFileBinary file         let (src2,c) = dropAppend src+            ans = (if '\r' `elem` src then windowsNewLine else id)+                  (src2 ++ if null res then "" else appendMsg ++ hashString res ++ "\n" ++ res)         when c $ putStrLn "Warning, Checksum does not match, please edit the file manually"-        writeFile file $ src2 ++ (if null res then "" else appendMsg ++ hashString res ++ "\n" ++ res)+        writeFileBinary file ans      else do         let modline = concat $ take 1 ["module " ++ x ++ " where\n" | Module x <- flgs]             impline = unlines ["import " ++ if null i then modname else i | Import i <- flgs]@@ -278,3 +285,33 @@     if b then openTempFileLocal dir template else do         h <- openFile s ReadWriteMode         return (s, h)+++readFile' :: FilePath -> IO String+readFile' file = do+    h <- openFile file ReadMode+    res <- hGetContents h+    length res `seq` return ()+    hClose h+    return res+++readFileBinary :: FilePath -> IO String+readFileBinary file = do+    h <- openBinaryFile file ReadMode+    hGetContents h+++writeFileBinary :: FilePath -> String -> IO ()+writeFileBinary file s = do+    h <- openBinaryFile file WriteMode+    hPutStr h s+    hClose h+++windowsNewLine :: String -> String+windowsNewLine ('\r':'\n':xs) = '\r':'\n': windowsNewLine xs+windowsNewLine ('\n':xs) = '\r':'\n': windowsNewLine xs+windowsNewLine (x:xs) = x : windowsNewLine xs+windowsNewLine [] = []+
Language/Haskell/TH/All.hs view
@@ -4,7 +4,7 @@     module Language.Haskell.TH.All,     module Language.Haskell.TH.Syntax, module Language.Haskell.TH.Peephole,     module Language.Haskell.TH.Helper, module Language.Haskell.TH.FixedPpr,-    module Language.Haskell.TH.Data, +    module Language.Haskell.TH.Data,   module Language.Haskell.TH.ExpandSynonym,     module Language.Haskell.TH.SYB     ) where @@ -12,6 +12,7 @@ import Language.Haskell.TH.Peephole import Language.Haskell.TH.Helper import Language.Haskell.TH.FixedPpr+import Language.Haskell.TH.ExpandSynonym import Language.Haskell.TH.Data import Language.Haskell.TH.SYB
Language/Haskell/TH/Data.hs view
@@ -18,9 +18,12 @@   dataName :: DataDef -> String-dataName (DataD    _ name _ _ _) = show name-dataName (NewtypeD _ name _ _ _) = show name+dataName (DataD    _ name _ _ _) = show (unqualifiedName name)+dataName (NewtypeD _ name _ _ _) = show (unqualifiedName name) +qualifiedDataName :: DataDef -> Name+qualifiedDataName (DataD    _ name _ _ _) = name+qualifiedDataName (NewtypeD _ name _ _ _) = name  dataArity :: DataDef -> Int dataArity (DataD    _ _ xs _ _) = length xs@@ -33,12 +36,18 @@   ctorName :: CtorDef -> String-ctorName (NormalC name _ ) = show name-ctorName (RecC name _    ) = show name-ctorName (InfixC _ name _) = show name+ctorName (NormalC name _ ) = show (unqualifiedName name)+ctorName (RecC name _    ) = show (unqualifiedName name)+ctorName (InfixC _ name _) = show (unqualifiedName name) ctorName (ForallC _ _ c  ) = ctorName c +qualifiedCtorName :: CtorDef -> Name+qualifiedCtorName (NormalC name _ ) = name+qualifiedCtorName (RecC name _    ) = name+qualifiedCtorName (InfixC _ name _) = name+qualifiedCtorName (ForallC _ _ c  ) = qualifiedCtorName c + ctorArity :: CtorDef -> Int ctorArity (NormalC _ xs ) = length xs ctorArity (RecC _ xs    ) = length xs@@ -58,7 +67,7 @@   ctorFields :: CtorDef -> [String]-ctorFields (RecC name xs) = [show a | (a,b,c) <- xs]+ctorFields (RecC name varStrictType) = [show (unqualifiedName name) | (name,strict,typ) <- varStrictType] ctorFields _ = []  @@ -72,15 +81,14 @@   normData :: DataDef -> DataDef-normData = everywhere (mkT normType) . everywhere (mkT normName)+normData = everywhere (mkT normType)     where-        normName :: Name -> Name-        normName = mkName . dropModule . show-         normType :: Type -> Type         normType (ConT x) | show x == "[]" = ListT         normType x = x +unqualifiedName :: Name -> Name+unqualifiedName = mkName . dropModule . show   -- convert AppT chains back to a proper list
+ Language/Haskell/TH/ExpandSynonym.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE PatternGuards #-}++-- | Expand type synonyms in data declarations.+-- +--   This is needed for some type based derivations.+module Language.Haskell.TH.ExpandSynonym (expandData) where++import Language.Haskell.TH+import Language.Haskell.TH.Data+import Language.Haskell.TH.Syntax+import Language.Haskell.TH.SYB+import Data.Generics++-- | Expand type synonyms in a data declaration+expandData :: DataDef -> Q DataDef+expandData = everywhereM (mkM expandType)++expandType :: Type -> Q Type+expandType t = expandType' t []++-- Walk over a type, collecting applied arguments+expandType' :: Type -> [Type] -> Q Type+expandType'   (AppT t arg) args   = expandType' t (arg:args)+expandType' t@(ConT name)  args   = do result <- expandSyn name args+                                       case result of+                                          Just (t',args') -> everywhereM (mkM expandType) $ foldl AppT t' args'+                                          _               -> return $ foldl AppT t args+expandType' t              args   = return $ foldl AppT t args++-- Is the name a type synonym and are there enough arguments? if so, apply it+expandSyn :: Name -> [Type] -> Q (Maybe (Type, [Type]))+expandSyn name args = recover (return Nothing) $ do+            info <- reify name+            case info of+                   TyConI (TySynD _ synArgs t) | length args >= length synArgs+                        -> return $ Just (substitute synArgs argsInst t, argsMore) -- instantiate type synonym+                             where (argsInst,argsMore) = splitAt (length synArgs) args+                   _    -> return Nothing+      -- `recover` return Nothing++-- Substitute names for types in a type+substitute :: [Name] -> [Type] -> Type -> Type+substitute ns ts = subst (zip ns ts)+  where subst s (ForallT ns ctx t) = ForallT ns ctx (subst (filter ((`notElem` ns) . fst) s) t)+        subst s (VarT n)+           | Just t' <- lookup n s = t'+        subst s (AppT a b)         = AppT (subst s a) (subst s b)+        subst _ t                  = t
Language/Haskell/TH/SYB.hs view
@@ -6,7 +6,7 @@ import Language.Haskell.TH.Syntax import Data.PackedString -#ifndef NO_SYB    +#ifdef TH_SYB instance Data PackedString where gfoldl k z x = z x
derive.cabal view
@@ -1,6 +1,7 @@ Cabal-Version:  >= 1.2 Name:           derive-Version:        0.1.1+Version:        0.1.2+build-type:     Simple Copyright:      2006-7, Neil Mitchell Maintainer:     ndmitchell@gmail.com Homepage:       http://www-users.cs.york.ac.uk/~ndm/derive/@@ -24,11 +25,13 @@ Library     Extensions: CPP     Build-Depends: template-haskell, filepath, mtl+    if impl(ghc >= 6.10)+        build-depends: base == 4.*, syb     if flag(small_base)         Build-Depends: base >= 3, containers, pretty, packedstring, random, process, directory-        CPP-Options: "-DNO_SYB"     else         Build-Depends: base < 3+        CPP-Options: "-DTH_SYB"      Exposed-Modules:         Data.DeriveGuess@@ -67,6 +70,7 @@         Data.Derive.Uniplate         Language.Haskell.TH.All         Language.Haskell.TH.Data+        Language.Haskell.TH.ExpandSynonym         Language.Haskell.TH.FixedPpr         Language.Haskell.TH.Helper         Language.Haskell.TH.Peephole