diff --git a/Changelog b/Changelog --- a/Changelog +++ b/Changelog @@ -1,3 +1,8 @@ +DrIFT-2.3.0: + * Publish DrIFT in HackageDB. + * Get less warning message. + + DrIFT-2.2.2: * redid build model, collect deriving rules automatically. diff --git a/DrIFT-cabalized.cabal b/DrIFT-cabalized.cabal --- a/DrIFT-cabalized.cabal +++ b/DrIFT-cabalized.cabal @@ -1,5 +1,5 @@ name: DrIFT-cabalized -version: 2.2.4 +version: 2.3.0 synopsis: Program to derive type class instances description: DrIFT is a type sensitive preprocessor for Haskell. It extracts type declarations and directives from modules. The directives cause rules to be fired on the parsed @@ -18,7 +18,7 @@ license-file: LICENSE -- For contributors & what they did, see AUTHORS author: Noel Winstanley, John Meacham -maintainer: , Kiwamu Okabe +maintainer: gwern , Metasepi team homepage: http://repetae.net/computer/haskell/DrIFT/ Cabal-Version: >= 1.6 @@ -33,7 +33,7 @@ type: git location: https://github.com/ajhc/drift.git -executable DrIFT-cabalized +executable DrIFT build-depends: base >= 4.0 && < 5, random, old-time main-is: DrIFT.hs hs-source-dirs: src, ./ @@ -44,9 +44,9 @@ Rules.FunctorM, PreludData, ParseLib2, DataP, ChaseImports, Pretty, RuleUtils, Unlit, GetOpt - ghc-options: -Wall + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-unused-do-bind -fno-warn-missing-signatures -executable DrIFT-cabalized-ghc +executable drift-ghc build-depends: base >= 4.0 && < 5, process main-is: drift-ghc.hs - ghc-options: -Wall + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-unused-do-bind -fno-warn-missing-signatures diff --git a/src/DrIFT.hs b/src/DrIFT.hs --- a/src/DrIFT.hs +++ b/src/DrIFT.hs @@ -33,6 +33,7 @@ } +env :: Env env = Env { envVerbose = False, envOutput = Nothing, @@ -45,6 +46,7 @@ } +getOutput :: Env -> IO Handle getOutput e = maybe (return stdout) (\fn -> openFile fn WriteMode) (envOutput e) options :: [OptDescr (Env -> Env)] @@ -60,8 +62,10 @@ , Option ['i'] ["ignore"] (NoArg (\e->e{envIgnoreDirectives = True})) "ignore directives in file. useful with -g" ] +setArg :: String -> Env -> Env setArg x e = e {envArgs = (n, tail rest):(envArgs e)} where (n,rest) = span (/= ':') x +addGlobalRule :: Tag -> Env -> Env addGlobalRule x e = e {envGlobalRules = x:(envGlobalRules e)} @@ -71,12 +75,15 @@ fstEq (a,_) (b,_) = a == b fstOrd (a,_) (b,_) = compare a b +doList :: IO () doList = do let rn = categorize [(c,(n,h)) | (n,_,c,h,_) <- Rules.rules] putStrLn $ unlines $ buildTableLL $ concat [ (c ++ ":","") : (map (\(a,b) -> (" " ++ a, b)) $ sort xs)| (c,xs)<- rn] +header :: String header = "Usage: DrIFT [OPTION...] file" +main :: IO () main = do argv <- getArgs (env,n) <- case (getOpt Permute options argv) of @@ -91,6 +98,7 @@ +derive :: Env -> FilePath -> IO () derive env fname = do let findent xs = f (lines xs) where f (x:xs) = let (w,n) = span isSpace x in case n of @@ -115,6 +123,7 @@ hFlush handle +addGlobals :: Env -> [([Tag], Data)] -> [([Tag], Data)] addGlobals env tds = (envGlobalRules env,Directive):concatMap f tds where f x | not (envIgnoreDirectives env) = [x] f (_,Directive) = [] @@ -122,9 +131,12 @@ f (_,d) = [([],d)] +rules :: [(String, Data -> Doc)] rules = map (\(a,b,_,_,_) -> (a,b)) Rules.rules -- codeRender doc = fullRender PageMode 80 1 doc "" -- now obsolete +vsep :: [Doc] -> Doc vsep = vcat . map ($$ (text "")) +sepDoc :: Doc sepDoc = commentLine . text $ " Imported from other files :-" backup :: FilePath -> FilePath @@ -151,7 +163,7 @@ find :: Tag -> [Rule] -> (Data -> Doc) find t r = case filter ((==t) . fst) $ r of [] -> const (commentLine warning) - (x:xs) -> snd x + (x:_) -> snd x where warning = hsep . texts $ ["Warning : Rule",t,"not found."] diff --git a/src/GenUtil.hs b/src/GenUtil.hs --- a/src/GenUtil.hs +++ b/src/GenUtil.hs @@ -217,22 +217,18 @@ snds :: [(a,b)] -> [b] snds = map snd -{-# INLINE repeatM #-} {-# SPECIALIZE repeatM :: IO a -> IO [a] #-} repeatM :: Monad m => m a -> m [a] repeatM x = sequence $ repeat x -{-# INLINE repeatM_ #-} {-# SPECIALIZE repeatM_ :: IO a -> IO () #-} repeatM_ :: Monad m => m a -> m () repeatM_ x = sequence_ $ repeat x -{-# INLINE replicateM #-} {-# SPECIALIZE replicateM :: Int -> IO a -> IO [a] #-} replicateM :: Monad m => Int -> m a -> m [a] replicateM n x = sequence $ replicate n x -{-# INLINE replicateM_ #-} {-# SPECIALIZE replicateM_ :: Int -> IO a -> IO () #-} replicateM_ :: Monad m => Int -> m a -> m () replicateM_ n x = sequence_ $ replicate n x diff --git a/src/Rules/Binary.hs b/src/Rules/Binary.hs --- a/src/Rules/Binary.hs +++ b/src/Rules/Binary.hs @@ -1,6 +1,6 @@ module Rules.Binary(rules) where -import Data.List (nub,intersperse) +-- import Data.List (nub,intersperse) import RuleUtils rules = [ diff --git a/src/Rules/BitsBinary.hs b/src/Rules/BitsBinary.hs --- a/src/Rules/BitsBinary.hs +++ b/src/Rules/BitsBinary.hs @@ -1,7 +1,7 @@ -- stub module to add your own rules. module Rules.BitsBinary(rules) where -import Data.List (nub,intersperse) +import Data.List (intersperse) import RuleUtils -- useful to have a look at this too rules = [ diff --git a/src/Rules/Utility.hs b/src/Rules/Utility.hs --- a/src/Rules/Utility.hs +++ b/src/Rules/Utility.hs @@ -1,6 +1,6 @@ module Rules.Utility(rules) where import RuleUtils -import GenUtil +-- import GenUtil rules :: [RuleDef] rules = [("Query",queryGen, "Utility", "provide a QueryFoo class with 'is', 'has', 'from', and 'get' routines", Nothing) ] diff --git a/src/Version.hs b/src/Version.hs --- a/src/Version.hs +++ b/src/Version.hs @@ -1,8 +1,10 @@ module Version(package, version, fullName) where +package :: String package = "DrIFT" -version = "2.2.4" - +version :: String +version = "2.3.0" +fullName :: String fullName = package ++ "-" ++ version