derive 2.4.2 → 2.5.1

raw patch · 10 files changed

+101/−74 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Derive/BinaryDefer.hs +1/−1
• Data/Derive/Foldable.hs +1/−1
• Data/Derive/Functor.hs +1/−1
• Data/Derive/Traversable.hs +1/−1
• Data/DeriveMain.hs +19/−0
• Derive/Derivation.hs +6/−6
• Derive/Flags.hs +1/−1
• Derive/Main.hs +59/−0
• Main.hs +3/−52
• derive.cabal +9/−11

@@ -14,7 +14,7 @@  instance (BinaryDefer e, BinaryDefer a) => BinaryDefer (FailList e a) where     bothDefer = defer [\ ~(o@Zoro) -> unit Zoro <<! o-                      ,\ ~(Fail x1) -> unit Fail << x1+                      ,\ ~(Fial x1) -> unit Fial << x1                       ,\ ~(Const x1 x2) -> unit Const << x1 << x2                       ] 

@@ -17,7 +17,7 @@ test :: FailList instance Foldable (FailList t1) where     foldr _  b Zoro = b-    foldr _  b (Fail _) = b+    foldr _  b (Fial _) = b     foldr _f b (Const a1 a2) = _f a1 (Data.Foldable.foldr _f b a2)  test :: Sample

@@ -20,7 +20,7 @@ test :: FailList instance Functor (FailList t1) where     fmap _  Zoro = Zoro-    fmap _  (Fail a1) = Fail a1+    fmap _  (Fial a1) = Fial a1     fmap _f (Const a1 a2) = Const (_f a1) (fmap _f a2)  test :: State

@@ -18,7 +18,7 @@  instance Traversable (FailList t1) where     traverse _f (Zoro) = pure Nil-    traverse _f (Fail a1) = pure (Fail a1)+    traverse _f (Fial a1) = pure (Fial a1)     traverse _f (Const a1 a2) = (Const <$> _f a1) <*> traverse _f a2  instance Traversable Sample where

@@ -0,0 +1,19 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- Needed for Haddock docs++-- | Use this module to create your own derive program, supporting custom derivations.+--   As an example:+--+-- @+--   import "Data.DeriveMain"        ('deriveMain')+--   import "Data.Derive.All"        ('derivations')+--   import MyProject.MyDerivation (myDerivation)+-- @+--+-- @+--   main :: IO+--   main = 'deriveMain' $ [myDerivation] ++ 'derivations'+-- @+module Data.DeriveMain(deriveMain) where++import Derive.Main+import Data.Derive.All(derivations)

@@ -9,7 +9,6 @@ import Data.List import Derive.Utils import Derive.Flags-import Data.Derive.All import Data.Derive.Internal.Derivation import qualified Data.Map as Map @@ -45,16 +44,17 @@ --------------------------------------------------------------------- -- ACTUALLY DERIVE IT -performDerive :: Module -> [Type] -> [String]-performDerive modu = concatMap ((:) "" . f)+performDerive :: [Derivation] -> Module -> [Type] -> [String]+performDerive derivations modu = concatMap ((:) "" . f)     where         grab = getDecl modu +        g = getDerivation derivations         f ty = case d ty grab (moduleName modu, grab typ1Name) of                 Left x -> unsafePerformIO $ let res = msg x in hPutStrLn stderr res >> return ["-- " ++ res]                 Right x -> concatMap (lines . prettyPrint) x             where-                d = derivationOp $ getDerivation clsName+                d = derivationOp $ g clsName                 (cls,typ1:_) = fromTyApps ty                 clsName = prettyPrint cls                 typ1Name = tyRoot typ1@@ -71,8 +71,8 @@         f _ = []  -getDerivation :: String -> Derivation-getDerivation = \name -> Map.findWithDefault (error $ "Don't know how to derive type class: " ++ name) name mp+getDerivation :: [Derivation] -> String -> Derivation+getDerivation derivations = \name -> Map.findWithDefault (error $ "Don't know how to derive type class: " ++ name) name mp     where         mp = Map.fromList $ map (derivationName &&& id) derivations 

@@ -38,7 +38,7 @@ getFlags = do     args <- getArgs     case getOpt Permute options args of-        (o,n,[]  ) | Version `elem` o -> putStrLn "Derive 2.0, (C) Neil Mitchell 2006-2009" >> exitSuccess+        (o,n,[]  ) | Version `elem` o -> putStrLn "Derive 2.4.* (C) Neil Mitchell 2006-2011" >> exitSuccess                    | Help `elem` o    -> putStr flagInfo >> exitSuccess                    | otherwise        -> do files <- mapM pickFile n; return (o, files)         (_,_,errs) -> hPutStr stderr (concat errs ++ flagInfo) >> exitFailure

@@ -0,0 +1,59 @@++module Derive.Main(deriveMain) where++import Language.Haskell+import Data.Derive.All(Derivation)+import Derive.Derivation+import Derive.Generate+import Derive.Test+import Derive.Flags+import Data.List+++deriveMain :: [Derivation] -> IO ()+deriveMain derivations = do+    (flags,files) <- getFlags+    if Test `elem` flags then+        test+     else if Generate `elem` flags then+        generate+     else if null files then+        putStr $ "No files specified\n" ++ flagInfo+     else+        mapM_ (mainFile derivations flags) files+++mainFile :: [Derivation] -> [Flag] -> FilePath -> IO ()+mainFile derivations flags file = do+    src <- readFile file+    src <- return $ unlines $ filter (not . isPrefixOf "#") $ lines src+    let parse = fromParseResult . parseFileContentsWithMode defaultParseMode{parseFilename=file,extensions=extension}+        real = parse src+        mine = parse $ uncomment src+    flags <- return $ foldl addFlags flags+        [(sl,words x) | OptionsPragma sl (Just (UnknownTool "DERIVE")) x <- modulePragmas mine]+    let res = performDerive derivations mine $ wantDerive flags real mine+    writeDerive file (moduleName mine) flags res+++uncomment :: String -> String+uncomment ('{':'-':'!':xs) = ' ':' ':' ':uncomment xs+uncomment ('!':'-':'}':xs) = ' ':' ':' ':uncomment xs+uncomment (x:xs) = x:uncomment xs+uncomment [] = []+++-- Taken from HLint, update occasionally+extension =+    [OverlappingInstances,UndecidableInstances,IncoherentInstances,RecursiveDo+    ,ParallelListComp,MultiParamTypeClasses,NoMonomorphismRestriction,FunctionalDependencies+    ,Rank2Types,RankNTypes,PolymorphicComponents,ExistentialQuantification,ScopedTypeVariables+    ,ImplicitParams,FlexibleContexts,FlexibleInstances,EmptyDataDecls+    ,KindSignatures,BangPatterns,TypeSynonymInstances,TemplateHaskell+    ,ForeignFunctionInterface,Generics,NoImplicitPrelude,NamedFieldPuns,PatternGuards+    ,GeneralizedNewtypeDeriving,ExtensibleRecords,RestrictedTypeSynonyms,HereDocuments+    ,MagicHash,TypeFamilies,StandaloneDeriving,UnicodeSyntax,PatternSignatures,UnliftedFFITypes+    ,LiberalTypeSynonyms,TypeOperators,RecordWildCards,RecordPuns,DisambiguateRecordFields+    ,OverloadedStrings,GADTs,MonoPatBinds,RelaxedPolyRec,ExtendedDefaultRules,UnboxedTuples+    ,DeriveDataTypeable,ConstrainedClassMethods,PackageImports,ImpredicativeTypes+    ,NewQualifiedOperators,PostfixOperators,QuasiQuotes,ViewPatterns]

@@ -1,58 +1,9 @@  module Main(main) where -import Language.Haskell-import Derive.Derivation-import Derive.Generate-import Derive.Test-import Derive.Flags-import Data.List+import Data.Derive.All+import Data.DeriveMain   main :: IO ()-main = do-    (flags,files) <- getFlags-    if Test `elem` flags then-        test-     else if Generate `elem` flags then-        generate-     else if null files then-        putStr $ "No files specified\n" ++ flagInfo-     else-        mapM_ (mainFile flags) files---mainFile :: [Flag] -> FilePath -> IO ()-mainFile flags file = do-    src <- readFile file-    src <- return $ unlines $ filter (not . isPrefixOf "#") $ lines src-    let parse = fromParseResult . parseFileContentsWithMode defaultParseMode{parseFilename=file,extensions=extension}-        real = parse src-        mine = parse $ uncomment src-    flags <- return $ foldl addFlags flags-        [(sl,words x) | OptionsPragma sl (Just (UnknownTool "DERIVE")) x <- modulePragmas mine]-    let res = performDerive mine $ wantDerive flags real mine-    writeDerive file (moduleName mine) flags res---uncomment :: String -> String-uncomment ('{':'-':'!':xs) = ' ':' ':' ':uncomment xs-uncomment ('!':'-':'}':xs) = ' ':' ':' ':uncomment xs-uncomment (x:xs) = x:uncomment xs-uncomment [] = []----- Taken from HLint, update occasionally-extension =-    [OverlappingInstances,UndecidableInstances,IncoherentInstances,RecursiveDo-    ,ParallelListComp,MultiParamTypeClasses,NoMonomorphismRestriction,FunctionalDependencies-    ,Rank2Types,RankNTypes,PolymorphicComponents,ExistentialQuantification,ScopedTypeVariables-    ,ImplicitParams,FlexibleContexts,FlexibleInstances,EmptyDataDecls-    ,KindSignatures,BangPatterns,TypeSynonymInstances,TemplateHaskell-    ,ForeignFunctionInterface,Generics,NoImplicitPrelude,NamedFieldPuns,PatternGuards-    ,GeneralizedNewtypeDeriving,ExtensibleRecords,RestrictedTypeSynonyms,HereDocuments-    ,MagicHash,TypeFamilies,StandaloneDeriving,UnicodeSyntax,PatternSignatures,UnliftedFFITypes-    ,LiberalTypeSynonyms,TypeOperators,RecordWildCards,RecordPuns,DisambiguateRecordFields-    ,OverloadedStrings,GADTs,MonoPatBinds,RelaxedPolyRec,ExtendedDefaultRules,UnboxedTuples-    ,DeriveDataTypeable,ConstrainedClassMethods,PackageImports,ImpredicativeTypes-    ,NewQualifiedOperators,PostfixOperators,QuasiQuotes,ViewPatterns]+main = deriveMain derivations

@@ -1,7 +1,7 @@ Cabal-Version:  >= 1.6 Build-Type:     Default Name:           derive-Version:        2.4.2+Version:        2.5.1 build-type:     Simple Copyright:      2006-2011, Neil Mitchell Maintainer:     ndmitchell@gmail.com@@ -23,25 +23,17 @@ Executable derive     Main-Is: Main.hs -    Other-Modules:-        Derive.Derivation-        Derive.Flags-        Derive.Generate-        Derive.Test-        Derive.Utils--    Build-Depends:-        directory, process, bytestring- Library     Build-Depends:         base == 4.*,         filepath, syb, template-haskell, containers, pretty,+        directory, process, bytestring,         haskell-src-exts >= 1.9 && < 1.11,         transformers == 0.2.*,         uniplate >= 1.5 && < 1.7      Exposed-Modules:+        Data.DeriveMain         Data.DeriveTH         Data.DeriveDSL         Data.Derive.All@@ -105,3 +97,9 @@     Other-Modules:         Data.Derive.Internal.Instance         Data.Derive.Internal.Traversal+        Derive.Main+        Derive.Derivation+        Derive.Flags+        Derive.Generate+        Derive.Test+        Derive.Utils