diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2014-09-16 v5.1.0.1 + * Fix building with haskell-src-exts-1.16.0 + * Loosen monad-journal dependency + 2014-09-12 v5.1.0.0 * GhcModError is now a recursive data type (`GMECabalConfigure`'s type changed) diff --git a/Language/Haskell/GhcMod/FillSig.hs b/Language/Haskell/GhcMod/FillSig.hs --- a/Language/Haskell/GhcMod/FillSig.hs +++ b/Language/Haskell/GhcMod/FillSig.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP #-} +{-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances #-} module Language.Haskell.GhcMod.FillSig ( sig @@ -12,7 +13,8 @@ import qualified Data.Map as M import Data.Maybe (isJust, catMaybes) import Exception (ghandle, SomeException(..)) -import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L)) +import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, + SrcSpan, Type, GenLocated(L)) import qualified GHC as G import qualified Name as G import qualified Language.Haskell.GhcMod.Gap as Gap @@ -34,13 +36,19 @@ ---------------------------------------------------------------- -- Possible signatures we can find: function or instance -data SigInfo = Signature SrcSpan [G.RdrName] (G.HsType G.RdrName) - | InstanceDecl SrcSpan G.Class - | TyFamDecl SrcSpan G.RdrName TyFamType {- True if closed -} [G.RdrName] +data SigInfo + = Signature SrcSpan [G.RdrName] (G.HsType G.RdrName) + | InstanceDecl SrcSpan G.Class + | TyFamDecl SrcSpan G.RdrName TyFamType {- True if closed -} [G.RdrName] -- Signature for fallback operation via haskell-src-exts -data HESigInfo = HESignature HE.SrcSpan [HE.Name HE.SrcSpanInfo] (HE.Type HE.SrcSpanInfo) - | HEFamSignature HE.SrcSpan TyFamType (HE.Name HE.SrcSpanInfo) [HE.Name HE.SrcSpanInfo] +data HESigInfo + = HESignature HE.SrcSpan [HE.Name HE.SrcSpanInfo] (HE.Type HE.SrcSpanInfo) + | HEFamSignature + HE.SrcSpan + TyFamType + (HE.Name HE.SrcSpanInfo) + [HE.Name HE.SrcSpanInfo] data TyFamType = Closed | Open | Data initialTyFamString :: TyFamType -> (String, String) @@ -143,34 +151,54 @@ HE.ParseOk (HE.Module _ _ _ _ mdecls) -> do decl <- find (typeSigInRangeHE lineNo colNo) mdecls case decl of - HE.TypeSig (HE.SrcSpanInfo s _) names ty -> return $ HESignature s names ty - HE.TypeFamDecl (HE.SrcSpanInfo s _) (HE.DHead _ name tys) _ -> + HE.TypeSig (HE.SrcSpanInfo s _) names ty -> + return $ HESignature s names ty + + HE.TypeFamDecl (HE.SrcSpanInfo s _) declHead _ -> + let (name, tys) = dHeadTyVars declHead in return $ HEFamSignature s Open name (map cleanTyVarBind tys) - HE.DataFamDecl (HE.SrcSpanInfo s _) _ (HE.DHead _ name tys) _ -> + + HE.DataFamDecl (HE.SrcSpanInfo s _) _ declHead _ -> + let (name, tys) = dHeadTyVars declHead in return $ HEFamSignature s Open name (map cleanTyVarBind tys) _ -> fail "" _ -> Nothing where cleanTyVarBind (HE.KindedVar _ n _) = n cleanTyVarBind (HE.UnkindedVar _ n) = n +#if MIN_VERSION_haskell_src_exts(1,16,0) + dHeadTyVars :: HE.DeclHead l -> (HE.Name l, [HE.TyVarBind l]) + dHeadTyVars (HE.DHead _ name) = (name, []) + dHeadTyVars (HE.DHApp _ r ty) = (++[ty]) `fmap` (dHeadTyVars r) + dHeadTyVars (HE.DHInfix _ ty name) = (name, [ty]) + dHeadTyVars (HE.DHParen _ r) = dHeadTyVars r +#else + dHeadTyVars :: HE.DeclHead l -> (HE.Name l, [HE.TyVarBind l]) + dHeadTyVars (DHead _ n tys) = (n, tys) +#endif + ---------------------------------------------------------------- -- b. Code for generating initial code --- A list of function arguments, and whether they are functions or normal arguments --- is built from either a function signature or an instance signature +-- A list of function arguments, and whether they are functions or normal +-- arguments is built from either a function signature or an instance signature data FnArg = FnArgFunction | FnArgNormal | FnExplicitName String initialBody :: FnArgsInfo ty name => DynFlags -> PprStyle -> ty -> name -> String -initialBody dflag style ty name = initialBody' (getFnName dflag style name) (getFnArgs ty) +initialBody dflag style ty name = + initialBody' (getFnName dflag style name) (getFnArgs ty) initialBody' :: String -> [FnArg] -> String -initialBody' fname args = initialHead fname args ++ " = " - ++ (if isSymbolName fname then "" else '_':fname) ++ "_body" +initialBody' fname args = + initialHead fname args ++ " = " ++ n ++ "_body" + where n = if isSymbolName fname then "" else '_':fname -initialFamBody :: FnArgsInfo ty name => DynFlags -> PprStyle -> name -> [name] -> String -initialFamBody dflag style name args = initialHead (getFnName dflag style name) - (map (FnExplicitName . getFnName dflag style) args) - ++ " = ()" +initialFamBody :: FnArgsInfo ty name + => DynFlags -> PprStyle -> name -> [name] -> String +initialFamBody dflag style name args = + initialHead fnName fnArgs ++ " = ()" + where fnName = getFnName dflag style name + fnArgs = map (FnExplicitName . getFnName dflag style) args initialHead :: String -> [FnArg] -> String initialHead fname args = @@ -185,7 +213,8 @@ initialBodyArgs (FnArgFunction:xs) vs (f:fs) = f : initialBodyArgs xs vs fs initialBodyArgs (FnArgNormal:xs) (v:vs) fs = v : initialBodyArgs xs vs fs initialBodyArgs (FnExplicitName n:xs) vs fs = n : initialBodyArgs xs vs fs -initialBodyArgs _ _ _ = error "This should never happen" -- Lists are infinite +initialBodyArgs _ _ _ = + error "initialBodyArgs: This should never happen" -- Lists are infinite initialHead1 :: String -> [FnArg] -> [String] -> String initialHead1 fname args elts = @@ -211,7 +240,8 @@ getFnName dflag style name = showOccName dflag style $ Gap.occName name getFnArgs (G.HsForAllTy _ _ _ (L _ iTy)) = getFnArgs iTy getFnArgs (G.HsParTy (L _ iTy)) = getFnArgs iTy - getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy + getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) = + (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy where fnarg ty = case ty of (G.HsForAllTy _ _ _ (L _ iTy)) -> fnarg iTy (G.HsParTy (L _ iTy)) -> fnarg iTy @@ -224,7 +254,8 @@ getFnName _ _ (HE.Symbol _ s) = s getFnArgs (HE.TyForall _ _ _ iTy) = getFnArgs iTy getFnArgs (HE.TyParen _ iTy) = getFnArgs iTy - getFnArgs (HE.TyFun _ lTy rTy) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy + getFnArgs (HE.TyFun _ lTy rTy) = + (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy where fnarg ty = case ty of (HE.TyForall _ _ _ iTy) -> fnarg iTy (HE.TyParen _ iTy) -> fnarg iTy @@ -239,7 +270,10 @@ maybe (if Ty.isPredTy lTy then getFnArgs' rTy else FnArgNormal:getFnArgs' rTy) (\_ -> FnArgFunction:getFnArgs' rTy) $ Ty.splitFunTy_maybe lTy - getFnArgs' ty | Just (_,iTy) <- Ty.splitForAllTy_maybe ty = getFnArgs' iTy + + getFnArgs' ty | Just (_,iTy) <- Ty.splitForAllTy_maybe ty = + getFnArgs' iTy + getFnArgs' _ = [] -- Infinite supply of variable and function variable names @@ -247,7 +281,9 @@ infiniteVars = infiniteSupply ["x","y","z","t","u","v","w"] infiniteFns = infiniteSupply ["f","g","h"] infiniteSupply :: [String] -> [String] -infiniteSupply initialSupply = initialSupply ++ concatMap (\n -> map (\v -> v ++ show n) initialSupply) ([1 .. ] :: [Integer]) +infiniteSupply initialSupply = + initialSupply ++ concatMap (\n -> map (\v -> v ++ show n) initialSupply) + ([1 .. ] :: [Integer]) -- Check whether a String is a symbol name isSymbolName :: String -> Bool @@ -273,14 +309,15 @@ p <- G.parseModule modSum tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p ety <- G.exprType expr - whenFound opt (findVar dflag style tcm tcs lineNo colNo) $ \(loc, name, rty, paren) -> - let eArgs = getFnArgs ety - rArgs = getFnArgs rty - diffArgs' = length eArgs - length rArgs - diffArgs = if diffArgs' < 0 then 0 else diffArgs' - iArgs = take diffArgs eArgs - text = initialHead1 expr iArgs (infinitePrefixSupply name) - in (fourInts loc, doParen paren text) + whenFound opt (findVar dflag style tcm tcs lineNo colNo) $ + \(loc, name, rty, paren) -> + let eArgs = getFnArgs ety + rArgs = getFnArgs rty + diffArgs' = length eArgs - length rArgs + diffArgs = if diffArgs' < 0 then 0 else diffArgs' + iArgs = take diffArgs eArgs + text = initialHead1 expr iArgs (infinitePrefixSupply name) + in (fourInts loc, doParen paren text) handler (SomeException _) = emptyResult =<< options @@ -289,14 +326,16 @@ -> G.TypecheckedModule -> G.TypecheckedSource -> Int -> Int -> m (Maybe (SrcSpan, String, Type, Bool)) findVar dflag style tcm tcs lineNo colNo = - let lst = sortBy (cmp `on` G.getLoc) $ listifySpans tcs (lineNo, colNo) :: [G.LHsExpr Id] + let lst = sortBy (cmp `on` G.getLoc) $ + listifySpans tcs (lineNo, colNo) :: [G.LHsExpr Id] in case lst of e@(L _ (G.HsVar i)):others -> do tyInfo <- Gap.getType tcm e let name = getFnName dflag style i if (name == "undefined" || head name == '_') && isJust tyInfo then let Just (s,t) = tyInfo - b = case others of -- If inside an App, we need parenthesis + b = case others of -- If inside an App, we need + -- parenthesis [] -> False L _ (G.HsApp (L _ a1) (L _ a2)):_ -> isSearchedVar i a1 || isSearchedVar i a2 @@ -333,24 +372,29 @@ opt <- options modSum <- Gap.fileModSummary file p <- G.parseModule modSum - tcm@TypecheckedModule{tm_typechecked_source = tcs - ,tm_checked_module_info = minfo} <- G.typecheckModule p + tcm@TypecheckedModule { + tm_typechecked_source = tcs + , tm_checked_module_info = minfo + } <- G.typecheckModule p whenFound' opt (findVar dflag style tcm tcs lineNo colNo) $ \(loc, _name, rty, paren) -> do topLevel <- getEverythingInTopLevel minfo let (f,pats) = getPatsForVariable tcs (lineNo,colNo) - -- Remove self function to prevent recursion, and id to trim cases + -- Remove self function to prevent recursion, and id to trim + -- cases filterFn (n,_) = let funName = G.getOccString n recName = G.getOccString (G.getName f) in funName `notElem` recName:notWantedFuns -- Find without using other functions in top-level - localBnds = M.unions $ map (\(L _ pat) -> getBindingsForPat pat) pats + localBnds = M.unions $ + map (\(L _ pat) -> getBindingsForPat pat) pats lbn = filter filterFn (M.toList localBnds) djinnsEmpty <- djinn True (Just minfo) lbn rty (Max 10) 100000 let -- Find with the entire top-level almostEnv = M.toList $ M.union localBnds topLevel env = filter filterFn almostEnv djinns <- djinn True (Just minfo) env rty (Max 10) 100000 - return (fourInts loc, map (doParen paren) $ nub (djinnsEmpty ++ djinns)) + return ( fourInts loc + , map (doParen paren) $ nub (djinnsEmpty ++ djinns)) handler (SomeException _) = emptyResult =<< options @@ -372,7 +416,8 @@ tyThingsToInfo :: [Ty.TyThing] -> M.Map G.Name Type tyThingsToInfo [] = M.empty -tyThingsToInfo (G.AnId i : xs) = M.insert (G.getName i) (Ty.varType i) (tyThingsToInfo xs) +tyThingsToInfo (G.AnId i : xs) = + M.insert (G.getName i) (Ty.varType i) (tyThingsToInfo xs) -- Getting information about constructors is not needed -- because they will be added by djinn-ghc when traversing types -- #if __GLASGOW_HASKELL__ >= 708 @@ -385,7 +430,8 @@ -- Find the Id of the function and the pattern where the hole is located getPatsForVariable :: G.TypecheckedSource -> (Int,Int) -> (Id, [Ty.LPat Id]) getPatsForVariable tcs (lineNo, colNo) = - let (L _ bnd:_) = sortBy (cmp `on` G.getLoc) $ listifySpans tcs (lineNo, colNo) :: [G.LHsBind Id] + let (L _ bnd:_) = sortBy (cmp `on` G.getLoc) $ + listifySpans tcs (lineNo, colNo) :: [G.LHsBind Id] in case bnd of G.PatBind { Ty.pat_lhs = L ploc pat } -> case pat of Ty.ConPatIn (L _ i) _ -> (i, [L ploc pat]) @@ -405,25 +451,34 @@ getBindingsForPat (Ty.VarPat i) = M.singleton (G.getName i) (Ty.varType i) getBindingsForPat (Ty.LazyPat (L _ l)) = getBindingsForPat l getBindingsForPat (Ty.BangPat (L _ b)) = getBindingsForPat b -getBindingsForPat (Ty.AsPat (L _ a) (L _ i)) = M.insert (G.getName a) (Ty.varType a) (getBindingsForPat i) +getBindingsForPat (Ty.AsPat (L _ a) (L _ i)) = + M.insert (G.getName a) (Ty.varType a) (getBindingsForPat i) #if __GLASGOW_HASKELL__ >= 708 -getBindingsForPat (Ty.ListPat l _ _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l +getBindingsForPat (Ty.ListPat l _ _) = + M.unions $ map (\(L _ i) -> getBindingsForPat i) l #else -getBindingsForPat (Ty.ListPat l _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l +getBindingsForPat (Ty.ListPat l _) = + M.unions $ map (\(L _ i) -> getBindingsForPat i) l #endif -getBindingsForPat (Ty.TuplePat l _ _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l -getBindingsForPat (Ty.PArrPat l _) = M.unions $ map (\(L _ i) -> getBindingsForPat i) l +getBindingsForPat (Ty.TuplePat l _ _) = + M.unions $ map (\(L _ i) -> getBindingsForPat i) l +getBindingsForPat (Ty.PArrPat l _) = + M.unions $ map (\(L _ i) -> getBindingsForPat i) l getBindingsForPat (Ty.ViewPat _ (L _ i) _) = getBindingsForPat i getBindingsForPat (Ty.SigPatIn (L _ i) _) = getBindingsForPat i getBindingsForPat (Ty.SigPatOut (L _ i) _) = getBindingsForPat i -getBindingsForPat (Ty.ConPatIn (L _ i) d) = M.insert (G.getName i) (Ty.varType i) (getBindingsForRecPat d) +getBindingsForPat (Ty.ConPatIn (L _ i) d) = + M.insert (G.getName i) (Ty.varType i) (getBindingsForRecPat d) getBindingsForPat (Ty.ConPatOut { Ty.pat_args = d }) = getBindingsForRecPat d getBindingsForPat _ = M.empty getBindingsForRecPat :: Ty.HsConPatDetails Id -> M.Map G.Name Type -getBindingsForRecPat (Ty.PrefixCon args) = M.unions $ map (\(L _ i) -> getBindingsForPat i) args -getBindingsForRecPat (Ty.InfixCon (L _ a1) (L _ a2)) = M.union (getBindingsForPat a1) (getBindingsForPat a2) -getBindingsForRecPat (Ty.RecCon (Ty.HsRecFields { Ty.rec_flds = fields })) = getBindingsForRecFields fields - where getBindingsForRecFields [] = M.empty - getBindingsForRecFields (Ty.HsRecField { Ty.hsRecFieldArg = (L _ a) } : fs) = - M.union (getBindingsForPat a) (getBindingsForRecFields fs) +getBindingsForRecPat (Ty.PrefixCon args) = + M.unions $ map (\(L _ i) -> getBindingsForPat i) args +getBindingsForRecPat (Ty.InfixCon (L _ a1) (L _ a2)) = + M.union (getBindingsForPat a1) (getBindingsForPat a2) +getBindingsForRecPat (Ty.RecCon (Ty.HsRecFields { Ty.rec_flds = fields })) = + getBindingsForRecFields fields + where getBindingsForRecFields [] = M.empty + getBindingsForRecFields (Ty.HsRecField {Ty.hsRecFieldArg = (L _ a)}:fs) = + M.union (getBindingsForPat a) (getBindingsForRecFields fs) diff --git a/elisp/ghc.el b/elisp/ghc.el --- a/elisp/ghc.el +++ b/elisp/ghc.el @@ -28,7 +28,7 @@ (< emacs-minor-version minor))) (error "ghc-mod requires at least Emacs %d.%d" major minor))) -(defconst ghc-version "5.1.0.0") +(defconst ghc-version "5.1.0.1") ;; (eval-when-compile ;; (require 'haskell-mode)) diff --git a/ghc-mod.cabal b/ghc-mod.cabal --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -1,5 +1,5 @@ Name: ghc-mod -Version: 5.1.0.0 +Version: 5.1.0.1 Author: Kazu Yamamoto Daniel Gröber Alejandro Serrano @@ -104,7 +104,7 @@ , ghc-syb-utils , hlint >= 1.8.61 , io-choice - , monad-journal >= 0.2.2.0 && < 0.2.3.2 + , monad-journal >= 0.4 , old-time , process , syb @@ -197,7 +197,7 @@ , ghc-syb-utils , hlint >= 1.7.1 , io-choice - , monad-journal >= 0.2.2.0 && < 0.2.3.2 + , monad-journal >= 0.4 , old-time , process , syb diff --git a/src/GHCMod.hs b/src/GHCMod.hs --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -29,23 +29,23 @@ usage :: String usage = progVersion ++ "Usage:\n" - ++ "\t ghc-mod list" ++ ghcOptHelp ++ "[-l] [-d]\n" - ++ "\t ghc-mod lang [-l]\n" - ++ "\t ghc-mod flag [-l]\n" - ++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] [-q] [:] [[:] ...]\n" - ++ "\t ghc-mod check" ++ ghcOptHelp ++ "\n" - ++ "\t ghc-mod expand" ++ ghcOptHelp ++ "\n" - ++ "\t ghc-mod debug" ++ ghcOptHelp ++ "\n" - ++ "\t ghc-mod info" ++ ghcOptHelp ++ " \n" - ++ "\t ghc-mod type" ++ ghcOptHelp ++ " \n" - ++ "\t ghc-mod split" ++ ghcOptHelp ++ " \n" - ++ "\t ghc-mod sig" ++ ghcOptHelp ++ " \n" - ++ "\t ghc-mod refine" ++ ghcOptHelp ++ " \n" - ++ "\t ghc-mod auto" ++ ghcOptHelp ++ " \n" - ++ "\t ghc-mod find \n" - ++ "\t ghc-mod lint [-h opt] \n" + ++ "\t ghc-mod list " ++ ghcOptHelp ++ "[-l] [-d]\n" + ++ "\t ghc-mod lang [-l]\n" + ++ "\t ghc-mod flag [-l]\n" + ++ "\t ghc-mod browse " ++ ghcOptHelp ++ "[-l] [-o] [-d] [-q] [:] [[:] ...]\n" + ++ "\t ghc-mod check " ++ ghcOptHelp ++ "\n" + ++ "\t ghc-mod expand " ++ ghcOptHelp ++ "\n" + ++ "\t ghc-mod debug " ++ ghcOptHelp ++ "\n" + ++ "\t ghc-mod info " ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod type " ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod split " ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod sig " ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod refine " ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod auto " ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod find \n" + ++ "\t ghc-mod lint [-h opt] \n" ++ "\t ghc-mod root\n" - ++ "\t ghc-mod doc \n" + ++ "\t ghc-mod doc \n" ++ "\t ghc-mod boot\n" ++ "\t ghc-mod version\n" ++ "\t ghc-mod help\n" @@ -56,32 +56,36 @@ ---------------------------------------------------------------- argspec :: [OptDescr (Options -> Options)] -argspec = [ Option "l" ["tolisp"] - (NoArg (\opts -> opts { outputStyle = LispStyle })) - "print as a list of Lisp" - , Option "h" ["hlintOpt"] - (ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt") - "hlint options" - , Option "g" ["ghcOpt"] - (ReqArg (\g opts -> opts { ghcUserOptions = g : ghcUserOptions opts }) "ghcOpt") - "GHC options" - , Option "v" ["verbose"] - (NoArg (\opts -> opts { ghcUserOptions = "-v" : ghcUserOptions opts })) - "verbose" - , Option "o" ["operators"] - (NoArg (\opts -> opts { operators = True })) - "print operators, too" - , Option "d" ["detailed"] - (NoArg (\opts -> opts { detailed = True })) - "print detailed info" - , Option "q" ["qualified"] - (NoArg (\opts -> opts { qualified = True })) - "show qualified names" - , Option "b" ["boundary"] - (ReqArg (\s opts -> opts { lineSeparator = LineSeparator s }) "sep") - "specify line separator (default is Nul string)" - ] +argspec = + let option s l udsc dsc = Option s l dsc udsc + reqArg udsc dsc = ReqArg dsc udsc + in + [ option "l" ["tolisp"] "print as a list of Lisp" $ + NoArg $ \o -> o { outputStyle = LispStyle } + , option "h" ["hlintOpt"] "hlint options" $ + reqArg "hlintOpt" $ \h o -> o { hlintOpts = h : hlintOpts o } + + , option "g" ["ghcOpt"] "GHC options" $ + reqArg "ghcOpt" $ \g o -> + o { ghcUserOptions = g : ghcUserOptions o } + + , option "v" ["verbose"] "verbose" $ + NoArg $ \o -> o { ghcUserOptions = "-v" : ghcUserOptions o } + + , option "o" ["operators"] "print operators, too" $ + NoArg $ \o -> o { operators = True } + + , option "d" ["detailed"] "print detailed info" $ + NoArg $ \o -> o { detailed = True } + + , option "q" ["qualified"] "show qualified names" $ + NoArg $ \o -> o { qualified = True } + + , option "b" ["boundary"] "specify line separator (default is Nul string)"$ + reqArg "sep" $ \s o -> o { lineSeparator = LineSeparator s } + ] + parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String]) parseArgs spec argv = case O.getOpt Permute spec argv of @@ -102,9 +106,7 @@ main :: IO () main = flip E.catches handlers $ do --- #if __GLASGOW_HASKELL__ >= 611 hSetEncoding stdout utf8 --- #endif args <- getArgs let (opt,cmdArg) = parseArgs argspec args let cmdArg0 = cmdArg !. 0