[jhc] Fwd: darcs patch: No use haskell98 (and 3 more)
Kiwamu Okabe
kiwamu at debian.or.jp
Tue Sep 24 14:00:27 CEST 2013
Forwarding.
---------- Forwarded message ----------
From: <kiwamu at debian.or.jp>
Date: Fri, Sep 13, 2013 at 5:09 PM
Subject: darcs patch: No use haskell98 (and 3 more)
To: Darcs Patch DrIFT <john at repetae.net>
4 patches for repository http://repetae.net/repos/DrIFT:
Thu Mar 28 14:42:41 JST 2013 kiwamu at debian.or.jp
* No use haskell98
Thu Mar 28 14:46:52 JST 2013 kiwamu at debian.or.jp
* Cabalize DrIFT.
Thu Mar 28 21:59:35 JST 2013 kiwamu at debian.or.jp
* Build Haskell pacakge (cabal) with the command "make cabal-install".
Fri Sep 13 17:08:13 JST 2013 kiwamu at debian.or.jp
* Change haskell package name, version name as library to be
depended by other package.
[No use haskell98
kiwamu at debian.or.jp**20130328054241
Ignore-this: 76849fb71f3f26260434c8fcc5da7976
] {
hunk ./configure.ac 19
GHC=$HC
GHCFLAGS=
-GHC_CHECK_MODULE([System],[],[],[],[HCFLAGS="$HCFLAGS
-hide-all-packages -package haskell98"])
+GHC_CHECK_MODULE([System.IO],[],[],[],[HCFLAGS="$HCFLAGS -hide-all-packages"])
AC_PROG_INSTALL
AC_PATH_PROGS(SH, sh)
hunk ./src/ChaseImports.hs 27
import DataP
import CommandP
import ParseLib2
-import System
-import List
+import System.Environment
+import Data.List
import qualified Unlit
hunk ./src/ChaseImports.hs 30
-import Monad
+import Control.Monad
import GenUtil
try x = catch (x >>= return . Right) (return . Left)
hunk ./src/DataP.lhs 13
>where
>import ParseLib2
->import Char
->import List
->import Monad
-
+>import Data.Char
+>import Data.List
>data Statement = DataStmt | NewTypeStmt deriving (Eq,Show)
>data Data = D { name :: Name, -- type name
hunk ./src/DrIFT.hs 10
import DataP
import GenUtil
import GetOpt
-import Char
-import IO hiding(try)
-import List (partition,isSuffixOf,sort, groupBy, sortBy)
-import Monad(unless)
+import Data.List (partition,isSuffixOf,sort, groupBy, sortBy)
+import Control.Monad(unless)
import PreludData(preludeData)
import Pretty
import RuleUtils (commentLine,texts)
hunk ./src/DrIFT.hs 18
import RuleUtils(Rule,Tag)
import Version
import qualified Rules(rules)
-import qualified System
+import System.IO
+import System.Environment
+import Data.Char
data Op = OpList | OpDerive | OpVersion
hunk ./src/DrIFT.hs 81
header = "Usage: DrIFT [OPTION...] file"
main = do
- argv <- System.getArgs
+ argv <- getArgs
(env,n) <- case (getOpt Permute options argv) of
(as,n,[]) -> return (foldr ($) env as ,n)
(_,_,errs) -> putErrDie (concat errs ++ usageInfo header options)
hunk ./src/GenUtil.hs 42
-- ** Simple deconstruction
fromLeft,fromRight,fsts,snds,splitEither,rights,lefts,
-- ** System routines
- exitSuccess, System.exitFailure, epoch, lookupEnv,endOfTime,
+ exitSuccess, exitFailure, epoch, lookupEnv,endOfTime,
-- ** Random routines
repMaybe,
liftT2, liftT3, liftT4,
hunk ./src/GenUtil.hs 94
UniqueProducer(..)
) where
-import Char(isAlphaNum, isSpace, toLower, ord)
-import List(group,sort)
-import List(intersperse, sortBy, groupBy)
-import Monad
-import qualified IO
-import qualified System
-import Random(StdGen, newStdGen, Random(randomR))
-import Time
+import System.Time
+import System.IO
+import System.IO.Error
+import System.Exit(exitFailure, exitWith, ExitCode(..))
+import System.Environment
+import Control.Monad(join, liftM, MonadPlus, mzero)
+import System.Random(StdGen, newStdGen, Random(randomR))
+import Data.Char(isAlphaNum, isSpace, toLower, ord)
+import Data.List(group,sort)
+import Data.List(intersperse, sortBy, groupBy)
+-- import Random(StdGen, newStdGen, Random(randomR))
{-# SPECIALIZE snub :: [String] -> [String] #-}
{-# SPECIALIZE snub :: [Int] -> [Int] #-}
hunk ./src/GenUtil.hs 133
-- | write string to standard error
putErr :: String -> IO ()
-putErr = IO.hPutStr IO.stderr
+putErr = System.IO.hPutStr System.IO.stderr
-- | write string and newline to standard error
putErrLn :: String -> IO ()
hunk ./src/GenUtil.hs 143
-- | write string and newline to standard error,
-- then exit program with failure.
putErrDie :: String -> IO a
-putErrDie s = putErrLn s >> System.exitFailure
+putErrDie s = putErrLn s >> exitFailure
-- | exit program successfully. 'exitFailure' is
hunk ./src/GenUtil.hs 149
-- also exported from System.
exitSuccess :: IO a
-exitSuccess = System.exitWith System.ExitSuccess
+exitSuccess = exitWith ExitSuccess
{-# INLINE fromRight #-}
hunk ./src/GenUtil.hs 387
-- | looks up an enviornment variable and returns it in a 'MonadPlus' rather
-- than raising an exception if the variable is not set.
lookupEnv :: MonadPlus m => String -> IO (m String)
-lookupEnv s = catch (fmap return $ System.getEnv s) (\e -> if
IO.isDoesNotExistError e then return mzero else ioError e)
+lookupEnv s = catch (fmap return $ getEnv s) (\e -> if
isDoesNotExistError e then return mzero else ioError e)
{-# SPECIALIZE fmapLeft :: (a -> c) -> [(Either a b)] -> [(Either c b)] #-}
fmapLeft :: Functor f => (a -> c) -> f (Either a b) -> f (Either c b)
hunk ./src/GenUtil.hs 501
-- arguments are given, read stdin.
getArgContents = do
- as <- System.getArgs
+ as <- getArgs
let f "-" = getContents
f fn = readFile fn
cs <- mapM f as
hunk ./src/GetOpt.hs 24
ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, getOpt
) where
-import List(isPrefixOf)
+import Data.List(isPrefixOf)
data ArgOrder a -- what to do with options
following non-options:
= RequireOrder -- no option processing
after first non-option
hunk ./src/ParseLib2.hs 34
many1_offside,many_offside,off,
opt, skipUntil, skipUntilOff,skipUntilParse,skipNest) where
-import Char
-import Monad
+import Data.Char
+import Control.Monad
infixr 5 +++
hunk ./src/Rules/Arbitrary.hs 3
module Rules.Arbitrary(rules) where
-import List
+import Data.List
import RuleUtils
rules = [
hunk ./src/Rules/Binary.hs 3
module Rules.Binary(rules) where
-import List (nub,intersperse)
+import Data.List (nub,intersperse)
import RuleUtils
rules = [
hunk ./src/Rules/BitsBinary.hs 4
-- stub module to add your own rules.
module Rules.BitsBinary(rules) where
-import List (nub,intersperse)
+import Data.List (nub,intersperse)
import RuleUtils -- useful to have a look at this too
rules = [
hunk ./src/Rules/FunctorM.hs 4
-- stub module to add your own rules.
module Rules.FunctorM (rules) where
-import List
+import Data.List
import RuleUtils
rules = [
hunk ./src/Rules/Generic.hs 6
-- import StandardRules
import RuleUtils
-import List(intersperse)
+import Data.List(intersperse)
rules :: [RuleDef]
hunk ./src/Rules/GhcBinary.hs 4
-- stub module to add your own rules.
module Rules.GhcBinary (rules) where
-import List (nub,intersperse)
+import Data.List (nub,intersperse)
import RuleUtils -- useful to have a look at this too
rules = [
hunk ./src/Rules/Monoid.hs 4
-- stub module to add your own rules.
module Rules.Monoid (rules) where
-import List
import RuleUtils
rules = [
hunk ./src/Rules/Standard.hs 4
module Rules.Standard(rules) where
import RuleUtils
-import List
+import Data.List
import GenUtil
hunk ./src/Rules/Utility.hs 3
module Rules.Utility(rules) where
import RuleUtils
-import List
import GenUtil
rules :: [RuleDef]
hunk ./src/Rules/Xml.hs 4
-- expanded from stub module to add new rules.
module Rules.Xml(rules) where
-import List (nub,sortBy)
+import Data.List (nub,sortBy)
import RuleUtils -- useful to have a look at this too
rules :: [RuleDef]
hunk ./src/Unlit.hs 7
-- "Report on the Programming Language Haskell",
-- version 1.2, appendix C.
-
-import Char
+import Data.Char
data Classified = Program String | Blank | Comment
| Include Int String | Pre String
}
[Cabalize DrIFT.
kiwamu at debian.or.jp**20130328054652
Ignore-this: 58f7a821c63d8f12da83d2726352771c
] {
addfile ./DrIFT-cabalized.cabal
hunk ./DrIFT-cabalized.cabal 1
+name: DrIFT-cabalized
+version: 2.2.3.3
+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
+ type declarations, generating new code which is
then appended to the bottom of the input
+ file. The rules are expressed as Haskell code,
and it is intended that the user can add new
+ rules as required.
+ .
+ DrIFT automates instance derivation for classes
that aren't supported by the standard compilers.
+ In addition, instances can be produced in
seperate modules to that containing the type declaration.
+ This allows instances to be derived for a type
after the original module has been compiled.
+ As a bonus, simple utility functions can also be
produced from a type.
+ .
+ This package was cabalized by gwern <gwern0 at gmail.com>.
+category: Data Structures
+license: BSD3
+license-file: LICENSE
+-- For contributors & what they did, see AUTHORS
+author: Noel Winstanley, John Meacham <john at repetae.net>
+maintainer: <gwern0 at gmail.com>, Kiwamu Okabe <kiwamu at debian.or.jp>
+homepage: http://repetae.net/computer/haskell/DrIFT/
+
+Cabal-Version: >= 1.6
+build-type: Simple
+data-files: AUTHORS, Changelog, README, README.old,
code/README.txt, docs/drift.texi, docs/drift.info,
+ example/README, example/TestTerm.out.correct
+extra-source-files:
+ code/GhcBinary.hs, code/FunctorM.hs, example/TestTerm.hs,
example/BTree.hs, example/Foo.lhs,
+ example/Xref.hs, example/Artifical.hs, example/Example.hs
+
+source-repository head
+ type: git
+ location: https://github.com/ajhc/drift.git
+
+executable DrIFT-cabalized
+ build-depends: base, random, old-time
+ main-is: DrIFT.hs
+ hs-source-dirs: src, ./
+ other-modules: CommandP, Version, GenUtil, Rules, Rules.Binary,
+ Rules.GhcBinary, Rules.Arbitrary,
+ Rules.Monoid, Rules.BitsBinary, Rules.Xml,
+ Rules.Utility, Rules.Generic, Rules.Standard,
+ Rules.FunctorM, PreludData, ParseLib2,
+ DataP, ChaseImports, Pretty, RuleUtils,
+ Unlit, GetOpt
+ ghc-options: -Wall
+
+executable DrIFT-cabalized-ghc
+ build-depends: base, process
+ main-is: drift-ghc.hs
+ ghc-options: -Wall
addfile ./drift-ghc.hs
hunk ./drift-ghc.hs 1
+import Data.List (isInfixOf)
+import System.Cmd (rawSystem)
+import System.Environment (getArgs)
+import System.Exit (ExitCode(ExitSuccess))
+import Paths_DrIFT_cabalized (getBinDir)
hunk ./drift-ghc.hs 7
+main :: IO ExitCode
+main = do args <- getArgs
+ case args of
+ (a:b:c:[]) -> conditional a b c
+ _ -> error "This is a driver script allowing DrIFT to be
used seamlessly with ghc.\n \
+ \ in order to use it, pass '-pgmF drift-ghc
-F' to ghc when compiling your programs."
+
+conditional :: FilePath -> FilePath -> FilePath -> IO ExitCode
+conditional orgnl inf outf = do prefix <- getBinDir
+ infile <- readFile inf
+ if "{-!" `isInfixOf` infile then do
putStrLn (prefix ++ "DriFT-cabalized " ++
+
inf ++ " -o " ++ outf)
+
rawSystem inf ["-o", outf]
+ else do writeFile outf ("{-# LINE 1
\"" ++ orgnl ++ " #-}")
+ readFile inf >>= appendFile outf
+ return ExitSuccess
+{- GHC docs say: "-pgmF cmd
+ Use cmd as the pre-processor (with -F only).
+Use -pgmF cmd to select the program to use as the preprocessor.
+When invoked, the cmd pre-processor is given at least three arguments
on its command-line:
+1. the first argument is the name of the original source file,
+2. the second is the name of the file holding the input
+3. third is the name of the file where cmd should write its output to." -}
}
[Build Haskell pacakge (cabal) with the command "make cabal-install".
kiwamu at debian.or.jp**20130328125935
Ignore-this: 918ff70482a3aa96ef83983e6a69e0b8
] {
hunk ./Makefile.am 45
make -C $(PUBLISH_DIR) || true
+src/Rules.hs:
+ make -C src Rules.hs
+
+cabal-install: src/Rules.hs docs/drift.info
+ cabal install
+
+cabal-dist: src/Rules.hs docs/drift.info
+ runhaskell Setup.hs sdist
rpm: depend $(PACKAGE_NAME).spec dist
cp $(PACKAGE_NAME)-$(VERSION).tar.gz $(HOME)/var/rpm/SOURCES/
addfile ./Setup.hs
hunk ./Setup.hs 1
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMainWithHooks defaultUserHooks
}
[Change haskell package name, version name as library to be depended
by other package.
kiwamu at debian.or.jp**20130913080813
Ignore-this: c836346d41f5207f9e6a1a33708b3349
] {
hunk ./Changelog 1
+DrIFT-2.3.0:
+ * Publish DrIFT in HackageDB.
+ * Get less warning message.
+
+
DrIFT-2.2.2:
* redid build model, collect deriving rules automatically.
hunk ./DrIFT-cabalized.cabal 1
-name: DrIFT-cabalized
-version: 2.2.3.3
-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
- type declarations, generating new code which is
then appended to the bottom of the input
- file. The rules are expressed as Haskell code,
and it is intended that the user can add new
- rules as required.
- .
- DrIFT automates instance derivation for classes
that aren't supported by the standard compilers.
- In addition, instances can be produced in
seperate modules to that containing the type declaration.
- This allows instances to be derived for a type
after the original module has been compiled.
- As a bonus, simple utility functions can also be
produced from a type.
- .
- This package was cabalized by gwern <gwern0 at gmail.com>.
-category: Data Structures
-license: BSD3
-license-file: LICENSE
--- For contributors & what they did, see AUTHORS
-author: Noel Winstanley, John Meacham <john at repetae.net>
-maintainer: <gwern0 at gmail.com>, Kiwamu Okabe <kiwamu at debian.or.jp>
-homepage: http://repetae.net/computer/haskell/DrIFT/
-
-Cabal-Version: >= 1.6
-build-type: Simple
-data-files: AUTHORS, Changelog, README, README.old,
code/README.txt, docs/drift.texi, docs/drift.info,
- example/README, example/TestTerm.out.correct
-extra-source-files:
- code/GhcBinary.hs, code/FunctorM.hs, example/TestTerm.hs,
example/BTree.hs, example/Foo.lhs,
- example/Xref.hs, example/Artifical.hs, example/Example.hs
-
-source-repository head
- type: git
- location: https://github.com/ajhc/drift.git
-
-executable DrIFT-cabalized
- build-depends: base, random, old-time
- main-is: DrIFT.hs
- hs-source-dirs: src, ./
- other-modules: CommandP, Version, GenUtil, Rules, Rules.Binary,
- Rules.GhcBinary, Rules.Arbitrary,
- Rules.Monoid, Rules.BitsBinary, Rules.Xml,
- Rules.Utility, Rules.Generic, Rules.Standard,
- Rules.FunctorM, PreludData, ParseLib2,
- DataP, ChaseImports, Pretty, RuleUtils,
- Unlit, GetOpt
- ghc-options: -Wall
-
-executable DrIFT-cabalized-ghc
- build-depends: base, process
- main-is: drift-ghc.hs
- ghc-options: -Wall
rmfile ./DrIFT-cabalized.cabal
addfile ./DrIFT.cabal.in
hunk ./DrIFT.cabal.in 1
+name: DrIFT
+version: @VERSION@
+synopsis: Program to derive type class instances
+description: Today Data.Derive
<http://hackage.haskell.org/package/derive> is good another solution
for DrFIT.
+ See the User Manual
<http://community.haskell.org/~ndm/darcs/derive/derive.htm>.
+ .
+ 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
+ type declarations, generating new code which is
then appended to the bottom of the input
+ file. The rules are expressed as Haskell code,
and it is intended that the user can add new
+ rules as required.
+ .
+ DrIFT automates instance derivation for classes
that aren't supported by the standard compilers.
+ In addition, instances can be produced in
seperate modules to that containing the type declaration.
+ This allows instances to be derived for a type
after the original module has been compiled.
+ As a bonus, simple utility functions can also be
produced from a type.
+ .
+ This package was cabalized by gwern <gwern0 at gmail.com>.
+category: Data Structures
+license: BSD3
+license-file: LICENSE
+-- For contributors & what they did, see AUTHORS
+author: Noel Winstanley, John Meacham <john at repetae.net>
+maintainer: gwern <gwern0 at gmail.com>, Metasepi team
<metasepi at gmail.com>
+homepage: http://repetae.net/computer/haskell/DrIFT/
+
+Cabal-Version: >= 1.8
+build-type: Simple
+data-files: AUTHORS, Changelog, README.md, README.old,
code/README.txt, docs/drift.texi, docs/drift.info,
+ example/README, example/TestTerm.out.correct
+extra-source-files:
+ code/GhcBinary.hs, code/FunctorM.hs, example/TestTerm.hs,
example/BTree.hs, example/Foo.lhs,
+ example/Xref.hs, example/Artifical.hs, example/Example.hs
+
+source-repository head
+ type: git
+ location: https://github.com/ajhc/drift.git
+
+library
+ hs-source-dirs: src
+ build-depends: base >= 4.0 && < 5
+ exposed-modules: DrIFT.Version
+ 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
+ build-depends: base >= 4.0 && < 5, random, old-time, DrIFT
+ main-is: DrIFT.hs
+ hs-source-dirs: src
+ other-modules: CommandP, GenUtil, Rules, Rules.Binary,
+ Rules.GhcBinary, Rules.Arbitrary,
+ Rules.Monoid, Rules.BitsBinary, Rules.Xml,
+ Rules.Utility, Rules.Generic, Rules.Standard,
+ Rules.FunctorM, PreludData, ParseLib2,
+ DataP, ChaseImports, Pretty, RuleUtils,
+ Unlit, GetOpt
+ 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-ghc
+ build-depends: base >= 4.0 && < 5, process
+ main-is: drift-ghc.hs
+ ghc-options: -Wall -fno-warn-name-shadowing
-fno-warn-unused-binds -fno-warn-unused-matches
-fno-warn-unused-do-bind -fno-warn-missing-signatures
hunk ./Makefile.am 16
Changelog README.old drift-ghc.in code \
code/FunctorM.hs code/GhcBinary.hs code/README.txt \
ac-macros/acincludepackage.m4 LICENSE docs/drift.html \
- DrIFT.spec
+ DrIFT.spec DrIFT-cabalized.cabal
bin_SCRIPTS = drift-ghc
hunk ./configure.ac 1
-AC_INIT([DrIFT],[2.2.3],john at repetae.net, [DrIFT])
+AC_INIT([DrIFT],[2.4.1],john at repetae.net, [DrIFT])
AC_CONFIG_SRCDIR(src/DrIFT.hs)
AC_CONFIG_MACRO_DIR(ac-macros)
AC_CONFIG_AUX_DIR(ac-macros)
hunk ./configure.ac 32
Makefile
src/Makefile
example/Makefile
- src/Version.hs
+ src/DrIFT/Version.hs
DrIFT.spec
drift-ghc
hunk ./configure.ac 36
+ DrIFT.cabal
)
hunk ./drift-ghc.hs 5
import System.Cmd (rawSystem)
import System.Environment (getArgs)
import System.Exit (ExitCode(ExitSuccess))
-import Paths_DrIFT_cabalized (getBinDir)
+import Paths_DrIFT (getBinDir)
main :: IO ExitCode
main = do args <- getArgs
hunk ./src/ChaseImports.hs 33
import Control.Monad
import GenUtil
-try x = catch (x >>= return . Right) (return . Left)
+try x = iocatch (x >>= return . Right) (return . Left)
--- Split up input ---------------------------------------------------------
splitString :: String -> String -> (String,String)
adddir ./src/DrIFT
hunk ./src/DrIFT.hs 16
import Pretty
import RuleUtils (commentLine,texts)
import RuleUtils(Rule,Tag)
-import Version
+import DrIFT.Version
import qualified Rules(rules)
import System.IO
import System.Environment
hunk ./src/DrIFT.hs 36
}
+env :: Env
env = Env {
envVerbose = False,
envOutput = Nothing,
hunk ./src/DrIFT.hs 49
}
+getOutput :: Env -> IO Handle
getOutput e = maybe (return stdout) (\fn -> openFile fn WriteMode)
(envOutput e)
options :: [OptDescr (Env -> Env)]
hunk ./src/DrIFT.hs 65
, 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
hunk ./src/DrIFT.hs 68
+addGlobalRule :: Tag -> Env -> Env
addGlobalRule x e = e {envGlobalRules = x:(envGlobalRules e)}
hunk ./src/DrIFT.hs 78
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]
hunk ./src/DrIFT.hs 84
+header :: String
header = "Usage: DrIFT [OPTION...] file"
hunk ./src/DrIFT.hs 86
+main :: IO ()
main = do
argv <- getArgs
(env,n) <- case (getOpt Permute options argv) of
hunk ./src/DrIFT.hs 101
+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
hunk ./src/DrIFT.hs 126
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) = []
hunk ./src/DrIFT.hs 134
f (_,d) = [([],d)]
+rules :: [(String, Data -> Doc)]
rules = map (\(a,b,_,_,_) -> (a,b)) Rules.rules
-- codeRender doc = fullRender PageMode 80 1 doc "" -- now obsolete
hunk ./src/DrIFT.hs 137
+vsep :: [Doc] -> Doc
vsep = vcat . map ($$ (text ""))
hunk ./src/DrIFT.hs 139
+sepDoc :: Doc
sepDoc = commentLine . text $ " Imported from other files :-"
backup :: FilePath -> FilePath
hunk ./src/DrIFT.hs 166
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."]
addfile ./src/DrIFT/Version.hs.in
hunk ./src/DrIFT/Version.hs.in 1
+module DrIFT.Version(package, version, fullName) where
+
+package :: String
+package = "@PACKAGE@"
+
+version :: String
+version = "@VERSION@"
+
+fullName :: String
+fullName = package ++ "-" ++ version
hunk ./src/GenUtil.hs 89
readsM,
split,
tokens,
+ iocatch,
-- * Classes
UniqueProducer(..)
hunk ./src/GenUtil.hs 97
import System.Time
import System.IO
-import System.IO.Error
+import System.IO.Error(isDoesNotExistError)
+import Control.Exception
import System.Exit(exitFailure, exitWith, ExitCode(..))
hunk ./src/GenUtil.hs 100
-import System.Environment
+import System.Environment(getArgs, getEnv)
import Control.Monad(join, liftM, MonadPlus, mzero)
hunk ./src/GenUtil.hs 102
+import Prelude hiding (catch)
import System.Random(StdGen, newStdGen, Random(randomR))
import Data.Char(isAlphaNum, isSpace, toLower, ord)
import Data.List(group,sort)
hunk ./src/GenUtil.hs 112
{-# SPECIALIZE snub :: [String] -> [String] #-}
{-# SPECIALIZE snub :: [Int] -> [Int] #-}
+-- | catch function only for IOException
+iocatch :: IO a -> (IOException -> IO a) -> IO a
+iocatch = catch
+
-- | sorted nub of list, much more efficient than nub, but doesnt
preserve ordering.
snub :: Ord a => [a] -> [a]
snub = map head . group . sort
hunk ./src/GenUtil.hs 220
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
hunk ./src/GenUtil.hs 224
-{-# INLINE repeatM_ #-}
{-# SPECIALIZE repeatM_ :: IO a -> IO () #-}
repeatM_ :: Monad m => m a -> m ()
repeatM_ x = sequence_ $ repeat x
hunk ./src/GenUtil.hs 228
-{-# INLINE replicateM #-}
{-# SPECIALIZE replicateM :: Int -> IO a -> IO [a] #-}
replicateM :: Monad m => Int -> m a -> m [a]
replicateM n x = sequence $ replicate n x
hunk ./src/GenUtil.hs 232
-{-# INLINE replicateM_ #-}
{-# SPECIALIZE replicateM_ :: Int -> IO a -> IO () #-}
replicateM_ :: Monad m => Int -> m a -> m ()
replicateM_ n x = sequence_ $ replicate n x
hunk ./src/GenUtil.hs 293
lefts xs = [x | Left x <- xs]
ioM :: Monad m => IO a -> IO (m a)
-ioM action = catch (fmap return action) (\e -> return (fail (show e)))
+ioM action = iocatch (fmap return action) (\e -> return (fail (show e)))
ioMp :: MonadPlus m => IO a -> IO (m a)
hunk ./src/GenUtil.hs 296
-ioMp action = catch (fmap return action) (\_ -> return mzero)
+ioMp action = iocatch (fmap return action) (\_ -> return mzero)
-- | reformat a string to not be wider than a given width, breaking it up
-- between words.
hunk ./src/GenUtil.hs 390
-- | looks up an enviornment variable and returns it in a 'MonadPlus' rather
-- than raising an exception if the variable is not set.
lookupEnv :: MonadPlus m => String -> IO (m String)
-lookupEnv s = catch (fmap return $ getEnv s) (\e -> if
isDoesNotExistError e then return mzero else ioError e)
+lookupEnv s = iocatch (fmap return $ getEnv s) (\e -> if
isDoesNotExistError e then return mzero else ioError e)
{-# SPECIALIZE fmapLeft :: (a -> c) -> [(Either a b)] -> [(Either c b)] #-}
fmapLeft :: Functor f => (a -> c) -> f (Either a b) -> f (Either c b)
hunk ./src/Makefile.am 10
bin_PROGRAMS = DrIFT
DrIFT_SOURCES = ${RULES} ChaseImports.hs CommandP.hs DataP.lhs
DrIFT.hs GetOpt.hs \
- Unlit.hs ParseLib2.hs PreludData.hs Pretty.lhs RuleUtils.hs
Version.hs GenUtil.hs
+ Unlit.hs ParseLib2.hs PreludData.hs Pretty.lhs RuleUtils.hs GenUtil.hs
# DrIFT_static_SOURCES = $(DrIFT_SOURCES)
# DrIFT_static_LINK = $(DrIFT_LINK) -static -optl-static -ldl
hunk ./src/Makefile.am 31
# COMPILE = $(HC) $(HCFLAGS)
# all: DrIFT
-DrIFT: $(DrIFT_SOURCES) $(nodist_DrIFT_SOURCES)
+DrIFT$(EXEEXT): $(DrIFT_SOURCES) $(nodist_DrIFT_SOURCES)
$(HC) $(HCFLAGS) -i. -i at srcdir@ -hidir . -odir . -o $@ --make
@srcdir@/DrIFT.hs
#.hs.o:
hunk ./src/Rules/Binary.hs 3
module Rules.Binary(rules) where
-import Data.List (nub,intersperse)
+-- import Data.List (nub,intersperse)
import RuleUtils
rules = [
hunk ./src/Rules/BitsBinary.hs 4
-- 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 = [
hunk ./src/Rules/Utility.hs 3
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) ]
hunk ./src/Version.hs.in 1
-module Version(package, version, fullName) where
-
-package = "@PACKAGE@"
-
-version = "@VERSION@"
-
-
-fullName = package ++ "-" ++ version
rmfile ./src/Version.hs.in
}
--
Kiwamu Okabe
-------------- next part --------------
A non-text attachment was scrubbed...
Name: patch-preview.txt
Type: text/x-darcs-patch
Size: 28564 bytes
Desc: not available
URL: <http://www.haskell.org/pipermail/jhc/attachments/20130924/97677428/attachment.bin>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: no-use-haskell98.dpatch
Type: application/x-darcs-patch
Size: 30313 bytes
Desc: not available
URL: <http://www.haskell.org/pipermail/jhc/attachments/20130924/97677428/attachment-0001.bin>
More information about the jhc
mailing list