derive 2.1.0 → 2.2.0

raw patch · 6 files changed

+163/−26 lines, 6 filesdep ~haskell-src-extsdep ~uniplatePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-src-exts, uniplate

API changes (from Hackage documentation)

Files

• Data/Derive/All.hs +2/−1
• Data/Derive/Serialize.hs +134/−0
• Derive/Derivation.hs +6/−8
• Derive/Test.hs +12/−12
• derive.cabal +7/−4
• derive.htm +2/−1

@@ -30,6 +30,7 @@ import Data.Derive.Read                as D import Data.Derive.Ref                 as D import Data.Derive.Serial              as D+import Data.Derive.Serialize           as D import Data.Derive.Set                 as D import Data.Derive.Show                as D import Data.Derive.Traversable         as D@@ -38,5 +39,5 @@ import Data.Derive.UniplateTypeable    as D import Data.Derive.Update              as D derivations :: [Derivation]-derivations = [makeArbitrary,makeArbitraryOld,makeArities,makeBinary,makeBinaryDefer,makeBounded,makeData,makeDataAbstract,makeDefault,makeEnum,makeEnumCyclic,makeEq,makeFold,makeFoldable,makeFrom,makeFunctor,makeHas,makeIs,makeLazySet,makeMonoid,makeNFData,makeOrd,makeRead,makeRef,makeSerial,makeSet,makeShow,makeTraversable,makeTypeable,makeUniplateDirect,makeUniplateTypeable,makeUpdate]+derivations = [makeArbitrary,makeArbitraryOld,makeArities,makeBinary,makeBinaryDefer,makeBounded,makeData,makeDataAbstract,makeDefault,makeEnum,makeEnumCyclic,makeEq,makeFold,makeFoldable,makeFrom,makeFunctor,makeHas,makeIs,makeLazySet,makeMonoid,makeNFData,makeOrd,makeRead,makeRef,makeSerial,makeSerialize,makeSet,makeShow,makeTraversable,makeTypeable,makeUniplateDirect,makeUniplateTypeable,makeUpdate] -- GENERATED STOP

@@ -0,0 +1,134 @@+module Data.Derive.Serialize where+{-+import "cereal" Data.Serialize++example :: Sample++instance Serialize alpha => Serialize (Sample alpha) where+    put x = case x of+        First          -> do putTag 0+        Second  x1 x2  -> do putTag 1 ; put x1 ; put x2+        Third   x1     -> do putTag 2 ; put x1+        where+            useTag = length [First{}, Second{}, Third{}] > 1+            putTag x = when useTag (putWord8 x)++    get = do+        i <- getTag+        case i of+            0 -> do return (First)+            1 -> do x1 <- get ; x2 <- get ; return (Second x1 x2)+            2 -> do x1 <- get ; return (Third x1)+            _ -> error "Corrupted binary data for Sample"+        where+            useTag = length [First{}, Second{}, Third{}] > 1+            getTag = if useTag then getWord8 else return 0+++test :: List++instance Serialize a => Serialize (List a) where+    put x = case x of+        Nil -> putWord8 0+        Cons x1 x2 -> do putWord8 1; put x1; put x2++    get = do+        i <- getWord8+        case i of+            0 -> return Nil+            1 -> do x1 <- get; x2 <- get; return (Cons x1 x2)+            _ -> error "Corrupted binary data for List"++test :: Assoced++instance Serialize typ => Serialize (Assoced typ) where+    put (Assoced x1 x2) = do put x1; put x2+    get = do x1 <- get; x2 <- get; return (Assoced x1 x2)+++-}+-- GENERATED START++import Data.Derive.DSL.DSL+import Data.Derive.Internal.Derivation++makeSerialize :: Derivation+makeSerialize = derivationDSL "Serialize" dslSerialize++dslSerialize =+    List [Instance ["Serialize"] "Serialize" (List [App "InsDecl" (+    List [App "FunBind" (List [List [App "Match" (List [App "Ident" (+    List [String "put"]),List [App "PVar" (List [App "Ident" (List [+    String "x"])])],App "Nothing" (List []),App "UnGuardedRhs" (List [+    App "Case" (List [App "Var" (List [App "UnQual" (List [App "Ident"+    (List [String "x"])])]),MapCtor (App "Alt" (List [App "PApp" (List+    [App "UnQual" (List [App "Ident" (List [CtorName])]),MapField (App+    "PVar" (List [App "Ident" (List [Concat (List [String "x",ShowInt+    FieldIndex])])]))]),App "UnGuardedAlt" (List [App "Do" (List [+    Concat (List [List [App "Qualifier" (List [App "App" (List [App+    "Var" (List [App "UnQual" (List [App "Ident" (List [String+    "putTag"])])]),App "Lit" (List [App "Int" (List [CtorIndex])])])])+    ],MapField (App "Qualifier" (List [App "App" (List [App "Var" (+    List [App "UnQual" (List [App "Ident" (List [String "put"])])]),+    App "Var" (List [App "UnQual" (List [App "Ident" (List [Concat (+    List [String "x",ShowInt FieldIndex])])])])])]))])])]),App+    "BDecls" (List [List []])]))])]),App "BDecls" (List [List [App+    "PatBind" (List [App "PVar" (List [App "Ident" (List [String+    "useTag"])]),App "Nothing" (List []),App "UnGuardedRhs" (List [App+    "InfixApp" (List [App "App" (List [App "Var" (List [App "UnQual" (+    List [App "Ident" (List [String "length"])])]),App "List" (List [+    MapCtor (App "RecConstr" (List [App "UnQual" (List [App "Ident" (+    List [CtorName])]),List []]))])]),App "QVarOp" (List [App "UnQual"+    (List [App "Symbol" (List [String ">"])])]),App "Lit" (List [App+    "Int" (List [Int 1])])])]),App "BDecls" (List [List []])]),App+    "FunBind" (List [List [App "Match" (List [App "Ident" (List [+    String "putTag"]),List [App "PVar" (List [App "Ident" (List [+    String "x"])])],App "Nothing" (List []),App "UnGuardedRhs" (List [+    Application (List [App "Var" (List [App "UnQual" (List [App+    "Ident" (List [String "when"])])]),App "Var" (List [App "UnQual" (+    List [App "Ident" (List [String "useTag"])])]),App "Paren" (List [+    App "App" (List [App "Var" (List [App "UnQual" (List [App "Ident"+    (List [Concat (List [String "putWord",ShowInt (Int 8)])])])]),App+    "Var" (List [App "UnQual" (List [App "Ident" (List [String "x"])])+    ])])])])]),App "BDecls" (List [List []])])]])]])])]])]),App+    "InsDecl" (List [App "PatBind" (List [App "PVar" (List [App+    "Ident" (List [String "get"])]),App "Nothing" (List []),App+    "UnGuardedRhs" (List [App "Do" (List [List [App "Generator" (List+    [App "PVar" (List [App "Ident" (List [String "i"])]),App "Var" (+    List [App "UnQual" (List [App "Ident" (List [String "getTag"])])])+    ]),App "Qualifier" (List [App "Case" (List [App "Var" (List [App+    "UnQual" (List [App "Ident" (List [String "i"])])]),Concat (List [+    MapCtor (App "Alt" (List [App "PLit" (List [App "Int" (List [+    CtorIndex])]),App "UnGuardedAlt" (List [App "Do" (List [Concat (+    List [MapField (App "Generator" (List [App "PVar" (List [App+    "Ident" (List [Concat (List [String "x",ShowInt FieldIndex])])]),+    App "Var" (List [App "UnQual" (List [App "Ident" (List [String+    "get"])])])])),List [App "Qualifier" (List [App "App" (List [App+    "Var" (List [App "UnQual" (List [App "Ident" (List [String+    "return"])])]),App "Paren" (List [Application (Concat (List [List+    [App "Con" (List [App "UnQual" (List [App "Ident" (List [CtorName]+    )])])],MapField (App "Var" (List [App "UnQual" (List [App "Ident"+    (List [Concat (List [String "x",ShowInt FieldIndex])])])]))]))])])+    ])]])])]),App "BDecls" (List [List []])])),List [App "Alt" (List [+    App "PWildCard" (List []),App "UnGuardedAlt" (List [App "App" (+    List [App "Var" (List [App "UnQual" (List [App "Ident" (List [+    String "error"])])]),App "Lit" (List [App "String" (List [Concat (+    List [String "Corrupted binary data for ",DataName])])])])]),App+    "BDecls" (List [List []])])]])])])]])]),App "BDecls" (List [List [+    App "PatBind" (List [App "PVar" (List [App "Ident" (List [String+    "useTag"])]),App "Nothing" (List []),App "UnGuardedRhs" (List [App+    "InfixApp" (List [App "App" (List [App "Var" (List [App "UnQual" (+    List [App "Ident" (List [String "length"])])]),App "List" (List [+    MapCtor (App "RecConstr" (List [App "UnQual" (List [App "Ident" (+    List [CtorName])]),List []]))])]),App "QVarOp" (List [App "UnQual"+    (List [App "Symbol" (List [String ">"])])]),App "Lit" (List [App+    "Int" (List [Int 1])])])]),App "BDecls" (List [List []])]),App+    "PatBind" (List [App "PVar" (List [App "Ident" (List [String+    "getTag"])]),App "Nothing" (List []),App "UnGuardedRhs" (List [App+    "If" (List [App "Var" (List [App "UnQual" (List [App "Ident" (List+    [String "useTag"])])]),App "Var" (List [App "UnQual" (List [App+    "Ident" (List [Concat (List [String "getWord",ShowInt (Int 8)])])]+    )]),App "App" (List [App "Var" (List [App "UnQual" (List [App+    "Ident" (List [String "return"])])]),App "Lit" (List [App "Int" (+    List [Int 0])])])])]),App "BDecls" (List [List []])])]])])])])]+-- GENERATED STOP

@@ -89,15 +89,13 @@     let append = Append `elem` flags     let output = [x | Output x <- flags] -    let pre = take 1 ["module " ++ x ++ " where" | Modu x <- flags] ++-              ["import " ++ if null i then prettyPrint modu else i | Import i <- flags]+    let ans = take 1 ["module " ++ x ++ " where" | Modu x <- reverse flags] +++              ["import " ++ if null i then prettyPrint modu else i | Import i <- flags] +++              xs      when append $ do         src <- readFile' file-        writeGenerated file xs--    forM output $ \o ->-        writeFile o $ unlines $ pre ++ xs+        writeGenerated file ans -    when (not append && null output) $-        putStr $ unlines xs+    forM output $ \o -> writeFile o $ unlines ans+    when (not append && null output) $ putStr $ unlines ans

@@ -19,7 +19,9 @@   -- These overlap with other derivations-overlap = ["BinaryDefer","EnumCyclic","LazySet","DataAbstract"]+overlaps =+    [["BinaryDefer","EnumCyclic","LazySet","DataAbstract"]+    ,["Serialize"]]  -- REASONS: -- UniplateDirect: Doesn't work through Template Haskell@@ -50,17 +52,15 @@     -- check the $(derive) bits     putStrLn "Type checking examples"     let name = "AutoGenerated_Test"-    devs <- sequence [ liftM ((,) d) $ readSrc $ "Data/Derive" </> derivationName d <.> "hs"-                     | d <- derivations, derivationName d `notElem` exclude]-    -    let within xs = flip elem xs . derivationName . fst-        (pri,norm) = partition (within priority) devs-        (dev2,dev1) = partition (within overlap) norm-    -    autoTest (name++"1") decls $ pri ++ dev1-    autoTest (name++"2") decls $ pri ++ dev2-    writeFile (name++".hs") $ unlines-        ["import "++name++"1","import "++name++"2","main = putStrLn \"Type checking successful\""]+    devs <- sequence [liftM ((,) d) $ readSrc $ "Data/Derive" </> derivationName d <.> "hs" | d <- derivations]+    let lookupDev x = fromMaybe (error $ "Couldn't find derivation: " ++ x) $ find ((==) x . derivationName . fst) devs++    let sets = zip [1..] $ map (map lookupDev) $ map (priority++) $+            [d | d <- map (derivationName . fst) devs, d `notElem` (exclude ++ priority ++ concat overlaps)] : overlaps++    forM sets $ \(i,xs) -> autoTest (name++show i) decls xs+    writeFile (name++".hs") $ unlines $+        ["import " ++ name ++ show (fst i) | i <- sets] ++ ["main = putStrLn \"Type checking successful\""]     res <- system $ "runhaskell " ++ name ++ ".hs"     when (res /= ExitSuccess) $ error "Failed to typecheck results" 

@@ -1,7 +1,7 @@ Cabal-Version:  >= 1.6 Build-Type:     Default Name:           derive-Version:        2.1.0+Version:        2.2.0 build-type:     Simple Copyright:      2006-2010, Neil Mitchell Maintainer:     ndmitchell@gmail.com@@ -35,8 +35,8 @@  Library     Build-Depends:-        haskell-src-exts == 1.3.* && >= 1.3.2, filepath, mtl,-        base == 4.*, syb, template-haskell, uniplate == 1.3.*, containers,+        haskell-src-exts == 1.6.*, filepath, mtl,+        base == 4.*, syb, template-haskell, uniplate == 1.4.*, containers,         pretty      Exposed-Modules:@@ -87,6 +87,7 @@         Data.Derive.Read         Data.Derive.Ref         Data.Derive.Serial+        Data.Derive.Serialize         Data.Derive.Set         Data.Derive.Show         Data.Derive.Traversable@@ -96,7 +97,9 @@         Data.Derive.Update -- GENERATED STOP -    Other-Modules:+        -- Mainly internal but some still people use them+        -- to implement derivations outside         Data.Derive.Internal.Derivation+    Other-Modules:         Data.Derive.Internal.Instance         Data.Derive.Internal.Traversal

@@ -72,7 +72,7 @@ <h3>Acknowledgements</h3>  <p>-    Thanks to everyone who has submitted patches and given assistance, including: Twan van Laarhoven, Spencer Janssen, Andrea Vezzosi, Samuel Bronson, Joel Raymont, Benedikt Huber, Stefan O'Rear.+    Thanks to everyone who has submitted patches and given assistance, including: Twan van Laarhoven, Spencer Janssen, Andrea Vezzosi, Samuel Bronson, Joel Raymont, Benedikt Huber, Stefan O'Rear, Robin Green. </p>  @@ -127,6 +127,7 @@ <li><b><a href='http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#t%3ARead'>Read</a></b> - from the library <a href='http://hackage.haskell.org/package/base'>base</a></li> <li><b><a href='http://hackage.haskell.org/packages/archive/derive/latest/doc/html/Data-Derive-Ref.html'>Ref</a></b></li> <li><b><a href='http://hackage.haskell.org/packages/archive/smallcheck/latest/doc/html/Test-SmallCheck.html#t%3ASerial'>Serial</a></b> - from the library <a href='http://hackage.haskell.org/package/smallcheck'>smallcheck</a></li>+<li><b><a href='http://hackage.haskell.org/packages/archive/cereal/latest/doc/html/Data-Serialize.html#t%3ASerialize'>Serialize</a></b> - from the library <a href='http://hackage.haskell.org/package/cereal'>cereal</a></li> <li><b><a href='http://hackage.haskell.org/packages/archive/derive/latest/doc/html/Data-Derive-Set.html'>Set</a></b></li> <li><b><a href='http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#t%3AShow'>Show</a></b> - from the library <a href='http://hackage.haskell.org/package/base'>base</a></li> <li><b><a href='http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Traversable.html#t%3ATraversable'>Traversable</a></b> - from the library <a href='http://hackage.haskell.org/package/base'>base</a></li>