1 files changed, 0 insertions, 394 deletions
diff --git a/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch b/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch
deleted file mode 100644
index 83c8ffd2a..000000000
--- a/standalone/no-th/haskell-patches/generic-deriving_remove-TH.patch
+++ /dev/null
@@ -1,394 +0,0 @@
-From 9a41401d903f160e11d56fff35c24eb59d97885d Mon Sep 17 00:00:00 2001
-From: Joey Hess <joey@kitenet.net>
-Date: Tue, 17 Dec 2013 19:04:40 +0000
-Subject: [PATCH] remove TH
-
----
- src/Generics/Deriving/TH.hs | 354 --------------------------------------------
- 1 file changed, 354 deletions(-)
-
-diff --git a/src/Generics/Deriving/TH.hs b/src/Generics/Deriving/TH.hs
-index 783cb65..9aab713 100644
---- a/src/Generics/Deriving/TH.hs
-+++ b/src/Generics/Deriving/TH.hs
-@@ -19,18 +19,6 @@
- 
- -- Adapted from Generics.Regular.TH
- module Generics.Deriving.TH (
--      
--      deriveMeta
--    , deriveData
--    , deriveConstructors
--    , deriveSelectors
--
--#if __GLASGOW_HASKELL__ < 701
--    , deriveAll
--    , deriveRepresentable0
--    , deriveRep0
--    , simplInstance
--#endif
-   ) where
- 
- import Generics.Deriving.Base
-@@ -41,124 +29,6 @@ import Language.Haskell.TH.Syntax (Lift(..))
- import Data.List (intercalate)
- import Control.Monad
- 
---- | Given the names of a generic class, a type to instantiate, a function in
---- the class and the default implementation, generates the code for a basic
---- generic instance.
--simplInstance :: Name -> Name -> Name -> Name -> Q [Dec]
--simplInstance cl ty fn df = do
--  i <- reify (genRepName 0 ty)
--  x <- newName "x"
--  let typ = ForallT [PlainTV x] [] 
--        ((foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT (genRepName 0 ty)) 
--          (typeVariables i)) `AppT` (VarT x))
--  fmap (: []) $ instanceD (cxt []) (conT cl `appT` conT ty)
--    [funD fn [clause [] (normalB (varE df `appE` 
--      (sigE (global 'undefined) (return typ)))) []]]
--
--
---- | Given the type and the name (as string) for the type to derive,
---- generate the 'Data' instance, the 'Constructor' instances, the 'Selector'
---- instances, and the 'Representable0' instance.
--deriveAll :: Name -> Q [Dec]
--deriveAll n =
--  do a <- deriveMeta n
--     b <- deriveRepresentable0 n
--     return (a ++ b)
--
---- | Given the type and the name (as string) for the type to derive,
---- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'
---- instances.
--deriveMeta :: Name -> Q [Dec]
--deriveMeta n =
--  do a <- deriveData n
--     b <- deriveConstructors n
--     c <- deriveSelectors n
--     return (a ++ b ++ c)
--
---- | Given a datatype name, derive a datatype and instance of class 'Datatype'.
--deriveData :: Name -> Q [Dec]
--deriveData = dataInstance
--
---- | Given a datatype name, derive datatypes and 
---- instances of class 'Constructor'.
--deriveConstructors :: Name -> Q [Dec]
--deriveConstructors = constrInstance
--
---- | Given a datatype name, derive datatypes and instances of class 'Selector'.
--deriveSelectors :: Name -> Q [Dec]
--deriveSelectors = selectInstance
--
---- | Given the type and the name (as string) for the Representable0 type
---- synonym to derive, generate the 'Representable0' instance.
--deriveRepresentable0 :: Name -> Q [Dec]
--deriveRepresentable0 n = do
--    rep0 <- deriveRep0 n
--    inst <- deriveInst n
--    return $ rep0 ++ inst
--
---- | Derive only the 'Rep0' type synonym. Not needed if 'deriveRepresentable0'
---- is used.
--deriveRep0 :: Name -> Q [Dec]
--deriveRep0 n = do
--  i <- reify n
--  fmap (:[]) $ tySynD (genRepName 0 n) (typeVariables i) (rep0Type n)
--
--deriveInst :: Name -> Q [Dec]
--deriveInst t = do
--  i <- reify t
--  let typ q = foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT q) 
--                (typeVariables i)
--#if __GLASGOW_HASKELL__ >= 707
--  let tyIns = TySynInstD ''Rep (TySynEqn [typ t] (typ (genRepName 0 t)))
--#else
--  let tyIns = TySynInstD ''Rep [typ t] (typ (genRepName 0 t))
--#endif
--  fcs <- mkFrom t 1 0 t
--  tcs <- mkTo   t 1 0 t
--  liftM (:[]) $
--    instanceD (cxt []) (conT ''Generic `appT` return (typ t))
--                         [return tyIns, funD 'from fcs, funD 'to tcs]
--
--
--dataInstance :: Name -> Q [Dec]
--dataInstance n = do
--  i <- reify n
--  case i of
--    TyConI (DataD    _ n _ _ _) -> mkInstance n
--    TyConI (NewtypeD _ n _ _ _) -> mkInstance n
--    _ -> return []
--  where
--    mkInstance n = do
--      ds <- mkDataData n
--      is <- mkDataInstance n
--      return $ [ds,is]
--
--constrInstance :: Name -> Q [Dec]
--constrInstance n = do
--  i <- reify n
--  case i of
--    TyConI (DataD    _ n _ cs _) -> mkInstance n cs
--    TyConI (NewtypeD _ n _ c  _) -> mkInstance n [c]
--    _ -> return []
--  where
--    mkInstance n cs = do
--      ds <- mapM (mkConstrData n) cs
--      is <- mapM (mkConstrInstance n) cs
--      return $ ds ++ is
--
--selectInstance :: Name -> Q [Dec]
--selectInstance n = do
--  i <- reify n
--  case i of
--    TyConI (DataD    _ n _ cs _) -> mkInstance n cs
--    TyConI (NewtypeD _ n _ c  _) -> mkInstance n [c]
--    _ -> return []
--  where
--    mkInstance n cs = do
--      ds <- mapM (mkSelectData n) cs
--      is <- mapM (mkSelectInstance n) cs
--      return $ concat (ds ++ is)
--
- typeVariables :: Info -> [TyVarBndr]
- typeVariables (TyConI (DataD    _ _ tv _ _)) = tv
- typeVariables (TyConI (NewtypeD _ _ tv _ _)) = tv
-@@ -179,233 +49,9 @@ genName = mkName . (++"_") . intercalate "_" . map nameBase
- genRepName :: Int -> Name -> Name
- genRepName n = mkName . (++"_") . (("Rep" ++ show n) ++) . nameBase
- 
--mkDataData :: Name -> Q Dec
--mkDataData n = dataD (cxt []) (genName [n]) [] [] []
--
--mkConstrData :: Name -> Con -> Q Dec
--mkConstrData dt (NormalC n _) =
--  dataD (cxt []) (genName [dt, n]) [] [] [] 
--mkConstrData dt r@(RecC _ _) =
--  mkConstrData dt (stripRecordNames r)
--mkConstrData dt (InfixC t1 n t2) =
--  mkConstrData dt (NormalC n [t1,t2])
--
--mkSelectData :: Name -> Con -> Q [Dec]
--mkSelectData dt r@(RecC n fs) = return (map one fs)
--  where one (f, _, _) = DataD [] (genName [dt, n, f]) [] [] []
--mkSelectData dt _ = return []
--
--
--mkDataInstance :: Name -> Q Dec
--mkDataInstance n =
--  instanceD (cxt []) (appT (conT ''Datatype) (conT $ genName [n]))
--    [funD 'datatypeName [clause [wildP] (normalB (stringE (nameBase n))) []]
--    ,funD 'moduleName   [clause [wildP] (normalB (stringE name)) []]]
--  where
--    name = maybe (error "Cannot fetch module name!") id (nameModule n)
--
--instance Lift Fixity where
--  lift Prefix      = conE 'Prefix
--  lift (Infix a n) = conE 'Infix `appE` [| a |] `appE` [| n |]
--
--instance Lift Associativity where
--  lift LeftAssociative  = conE 'LeftAssociative
--  lift RightAssociative = conE 'RightAssociative
--  lift NotAssociative   = conE 'NotAssociative
--
--mkConstrInstance :: Name -> Con -> Q Dec
--mkConstrInstance dt (NormalC n _) = mkConstrInstanceWith dt n []
--mkConstrInstance dt (RecC    n _) = mkConstrInstanceWith dt n
--      [ funD 'conIsRecord [clause [wildP] (normalB (conE 'True)) []]]
--mkConstrInstance dt (InfixC t1 n t2) =
--    do
--      i <- reify n
--      let fi = case i of
--                 DataConI _ _ _ f -> convertFixity f
--                 _ -> Prefix
--      instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
--        [funD 'conName   [clause [wildP] (normalB (stringE (nameBase n))) []],
--         funD 'conFixity [clause [wildP] (normalB [| fi |]) []]]
--  where
--    convertFixity (Fixity n d) = Infix (convertDirection d) n
--    convertDirection InfixL = LeftAssociative
--    convertDirection InfixR = RightAssociative
--    convertDirection InfixN = NotAssociative
--
--mkConstrInstanceWith :: Name -> Name -> [Q Dec] -> Q Dec
--mkConstrInstanceWith dt n extra = 
--  instanceD (cxt []) (appT (conT ''Constructor) (conT $ genName [dt, n]))
--    (funD 'conName [clause [wildP] (normalB (stringE (nameBase n))) []] : extra)
--
--mkSelectInstance :: Name -> Con -> Q [Dec]
--mkSelectInstance dt r@(RecC n fs) = return (map one fs) where
--  one (f, _, _) = 
--    InstanceD ([]) (AppT (ConT ''Selector) (ConT $ genName [dt, n, f]))
--      [FunD 'selName [Clause [WildP] 
--        (NormalB (LitE (StringL (nameBase f)))) []]]
--mkSelectInstance _ _ = return []
--
--rep0Type :: Name -> Q Type
--rep0Type n =
--    do
--      -- runIO $ putStrLn $ "processing " ++ show n
--      i <- reify n
--      let b = case i of
--                TyConI (DataD _ dt vs cs _) ->
--                  (conT ''D1) `appT` (conT $ genName [dt]) `appT` 
--                    (foldr1' sum (conT ''V1) 
--                      (map (rep0Con (dt, map tyVarBndrToName vs)) cs))
--                TyConI (NewtypeD _ dt vs c _) ->
--                  (conT ''D1) `appT` (conT $ genName [dt]) `appT`
--                    (rep0Con (dt, map tyVarBndrToName vs) c)
--                TyConI (TySynD t _ _) -> error "type synonym?" 
--                _ -> error "unknown construct" 
--      --appT b (conT $ mkName (nameBase n))
--      b where
--    sum :: Q Type -> Q Type -> Q Type
--    sum a b = conT ''(:+:) `appT` a `appT` b
--
--
--rep0Con :: (Name, [Name]) -> Con -> Q Type
--rep0Con (dt, vs) (NormalC n []) =
--    conT ''C1 `appT` (conT $ genName [dt, n]) `appT` 
--     (conT ''S1 `appT` conT ''NoSelector `appT` conT ''U1)
--rep0Con (dt, vs) (NormalC n fs) =
--    conT ''C1 `appT` (conT $ genName [dt, n]) `appT` 
--     (foldr1 prod (map (repField (dt, vs) . snd) fs)) where
--    prod :: Q Type -> Q Type -> Q Type
--    prod a b = conT ''(:*:) `appT` a `appT` b
--rep0Con (dt, vs) r@(RecC n []) =
--    conT ''C1 `appT` (conT $ genName [dt, n]) `appT` conT ''U1
--rep0Con (dt, vs) r@(RecC n fs) =
--    conT ''C1 `appT` (conT $ genName [dt, n]) `appT` 
--      (foldr1 prod (map (repField' (dt, vs) n) fs)) where
--    prod :: Q Type -> Q Type -> Q Type
--    prod a b = conT ''(:*:) `appT` a `appT` b
--
--rep0Con d (InfixC t1 n t2) = rep0Con d (NormalC n [t1,t2])
--
----dataDeclToType :: (Name, [Name]) -> Type
----dataDeclToType (dt, vs) = foldl (\a b -> AppT a (VarT b)) (ConT dt) vs
--
--repField :: (Name, [Name]) -> Type -> Q Type
----repField d t | t == dataDeclToType d = conT ''I
--repField d t = conT ''S1 `appT` conT ''NoSelector `appT`
--                 (conT ''Rec0 `appT` return t)
--
--repField' :: (Name, [Name]) -> Name -> (Name, Strict, Type) -> Q Type
----repField' d ns (_, _, t) | t == dataDeclToType d = conT ''I
--repField' (dt, vs) ns (f, _, t) = conT ''S1 `appT` conT (genName [dt, ns, f]) 
--                                    `appT` (conT ''Rec0 `appT` return t)
---- Note: we should generate Par0 too, at some point
--
--
--mkFrom :: Name -> Int -> Int -> Name -> Q [Q Clause]
--mkFrom ns m i n =
--    do
--      -- runIO $ putStrLn $ "processing " ++ show n
--      let wrapE e = lrE m i e
--      i <- reify n
--      let b = case i of
--                TyConI (DataD _ dt vs cs _) ->
--                  zipWith (fromCon wrapE ns (dt, map tyVarBndrToName vs)
--                    (length cs)) [0..] cs
--                TyConI (NewtypeD _ dt vs c _) ->
--                  [fromCon wrapE ns (dt, map tyVarBndrToName vs) 1 0 c]
--                TyConI (TySynD t _ _) -> error "type synonym?" 
--                  -- [clause [varP (field 0)] (normalB (wrapE $ conE 'K1 `appE` varE (field 0))) []]
--                _ -> error "unknown construct"
--      return b
--
--mkTo :: Name -> Int -> Int -> Name -> Q [Q Clause]
--mkTo ns m i n =
--    do
--      -- runIO $ putStrLn $ "processing " ++ show n
--      let wrapP p = lrP m i p
--      i <- reify n
--      let b = case i of
--                TyConI (DataD _ dt vs cs _) ->
--                  zipWith (toCon wrapP ns (dt, map tyVarBndrToName vs)
--                    (length cs)) [0..] cs
--                TyConI (NewtypeD _ dt vs c _) ->
--                  [toCon wrapP ns (dt, map tyVarBndrToName vs) 1 0 c]
--                TyConI (TySynD t _ _) -> error "type synonym?" 
--                  -- [clause [wrapP $ conP 'K1 [varP (field 0)]] (normalB $ varE (field 0)) []]
--                _ -> error "unknown construct" 
--      return b
--
--fromCon :: (Q Exp -> Q Exp) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
--fromCon wrap ns (dt, vs) m i (NormalC cn []) =
--  clause
--    [conP cn []]
--    (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ appE (conE 'M1) $ 
--      conE 'M1 `appE` (conE 'U1)) []
--fromCon wrap ns (dt, vs) m i (NormalC cn fs) =
--  -- runIO (putStrLn ("constructor " ++ show ix)) >>
--  clause
--    [conP cn (map (varP . field) [0..length fs - 1])]
--    (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE` 
--      foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map snd fs))) []
--  where prod x y = conE '(:*:) `appE` x `appE` y
--fromCon wrap ns (dt, vs) m i r@(RecC cn []) =
--  clause
--    [conP cn []]
--    (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE` (conE 'U1)) []
--fromCon wrap ns (dt, vs) m i r@(RecC cn fs) =
--  clause
--    [conP cn (map (varP . field) [0..length fs - 1])]
--    (normalB $ appE (conE 'M1) $ wrap $ lrE m i $ conE 'M1 `appE` 
--      foldr1 prod (zipWith (fromField (dt, vs)) [0..] (map trd fs))) []
--  where prod x y = conE '(:*:) `appE` x `appE` y
--fromCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
--  fromCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
--
--fromField :: (Name, [Name]) -> Int -> Type -> Q Exp
----fromField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conE 'I `appE` varE (field nr)
--fromField (dt, vs) nr t = conE 'M1 `appE` (conE 'K1 `appE` varE (field nr))
--
--toCon :: (Q Pat -> Q Pat) -> Name -> (Name, [Name]) -> Int -> Int -> Con -> Q Clause
--toCon wrap ns (dt, vs) m i (NormalC cn []) =
--    clause
--      [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'M1 [conP 'U1 []]]]]
--      (normalB $ conE cn) []
--toCon wrap ns (dt, vs) m i (NormalC cn fs) =
--    -- runIO (putStrLn ("constructor " ++ show ix)) >>
--    clause
--      [wrap $ conP 'M1 [lrP m i $ conP 'M1
--        [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map snd fs))]]]
--      (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
--  where prod x y = conP '(:*:) [x,y]
--toCon wrap ns (dt, vs) m i r@(RecC cn []) =
--    clause
--      [wrap $ conP 'M1 [lrP m i $ conP 'M1 [conP 'U1 []]]]
--      (normalB $ conE cn) []
--toCon wrap ns (dt, vs) m i r@(RecC cn fs) =
--    clause
--      [wrap $ conP 'M1 [lrP m i $ conP 'M1
--        [foldr1 prod (zipWith (toField (dt, vs)) [0..] (map trd fs))]]]
--      (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []
--  where prod x y = conP '(:*:) [x,y]
--toCon wrap ns (dt, vs) m i (InfixC t1 cn t2) =
--  toCon wrap ns (dt, vs) m i (NormalC cn [t1,t2])
--
--toField :: (Name, [Name]) -> Int -> Type -> Q Pat
----toField (dt, vs) nr t | t == dataDeclToType (dt, vs) = conP 'I [varP (field nr)]
--toField (dt, vs) nr t = conP 'M1 [conP 'K1 [varP (field nr)]]
--
--
- field :: Int -> Name
- field n = mkName $ "f" ++ show n
- 
--lrP :: Int -> Int -> (Q Pat -> Q Pat)
--lrP 1 0 p = p
--lrP m 0 p = conP 'L1 [p]
--lrP m i p = conP 'R1 [lrP (m-1) (i-1) p]
--
--lrE :: Int -> Int -> (Q Exp -> Q Exp)
--lrE 1 0 e = e
--lrE m 0 e = conE 'L1 `appE` e
--lrE m i e = conE 'R1 `appE` lrE (m-1) (i-1) e
- 
- trd (_,_,c) = c
- 
--- 
-1.8.5.1
-