This commit is contained in:
Kazu Yamamoto 2010-04-23 18:09:38 +09:00
parent 9af4a74abe
commit efd71c5d81
3 changed files with 11 additions and 11 deletions

View File

@ -27,7 +27,7 @@ getSyntax opt mname = do
hPutStrLn inp ":set prompt \"Prelude>\"" hPutStrLn inp ":set prompt \"Prelude>\""
hPutStrLn inp ":quit" hPutStrLn inp ":quit"
cs <- hGetContents out cs <- hGetContents out
return $ unlines $ dropTailer $ dropHeader $ lines $ cs return . unlines . dropTailer . dropHeader . lines $ cs
where where
isNotPrefixOf x y = not (x `isPrefixOf` y) isNotPrefixOf x y = not (x `isPrefixOf` y)
dropHeader xs = tail $ dropWhile (isNotPrefixOf "Prelude>") xs dropHeader xs = tail $ dropWhile (isNotPrefixOf "Prelude>") xs
@ -53,7 +53,7 @@ preprocess cs = case parse remove "remove" cs of
Left e -> error $ show e Left e -> error $ show e
modName :: Parser String modName :: Parser String
modName = (:) <$> (oneOf ['A'..'Z']) modName = (:) <$> oneOf ['A'..'Z']
<*> (many . oneOf $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'#") <*> (many . oneOf $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'#")
anyName :: Parser String anyName :: Parser String
@ -102,8 +102,8 @@ identifiers (Module _ _ _ _ _ _ x) = filter hid $ concatMap decl x
decl :: Decl -> [String] decl :: Decl -> [String]
decl (TypeSig _ [x] _) = [name x] decl (TypeSig _ [x] _) = [name x]
decl (DataDecl _ _ _ x _ y _) = name x : (map qualConDecl y) decl (DataDecl _ _ _ x _ y _) = name x : map qualConDecl y
decl (ClassDecl _ _ x _ _ y) = name x : (map classDecl y) decl (ClassDecl _ _ x _ _ y) = name x : map classDecl y
decl (TypeDecl _ x _ _) = [name x] decl (TypeDecl _ x _ _) = [name x]
decl x = [show x] decl x = [show x]

View File

@ -37,7 +37,7 @@ unfoldLines (x:xs) = x ++ unfold xs
unfold [] = "\n" unfold [] = "\n"
unfold (l:ls) unfold (l:ls)
| isAlpha (head l) = ('\n':l) ++ unfold ls | isAlpha (head l) = ('\n':l) ++ unfold ls
| otherwise = (drop 4 l) ++ "\0" ++ unfold ls | otherwise = drop 4 l ++ "\0" ++ unfold ls
---------------------------------------------------------------- ----------------------------------------------------------------

View File

@ -32,19 +32,19 @@ defaultOptions = Options { convert = toPlain
} }
argspec :: [OptDescr (Options -> Options)] argspec :: [OptDescr (Options -> Options)]
argspec = [ Option ['l'] ["tolisp"] argspec = [ Option "l" ["tolisp"]
(NoArg (\opts -> opts { convert = toLisp })) (NoArg (\opts -> opts { convert = toLisp }))
"print as a list of Lisp" "print as a list of Lisp"
, Option ['g'] ["ghc"] , Option "g" ["ghc"]
(ReqArg (\str opts -> opts { ghc = str }) "ghc") (ReqArg (\str opts -> opts { ghc = str }) "ghc")
"GHC path" "GHC path"
, Option ['i'] ["ghci"] , Option "i" ["ghci"]
(ReqArg (\str opts -> opts { ghci = str }) "ghci") (ReqArg (\str opts -> opts { ghci = str }) "ghci")
"ghci path" "ghci path"
, Option ['p'] ["ghc-pkg"] , Option "p" ["ghc-pkg"]
(ReqArg (\str opts -> opts { ghcPkg = str }) "ghc-pkg") (ReqArg (\str opts -> opts { ghcPkg = str }) "ghc-pkg")
"ghc-pkg path" "ghc-pkg path"
, Option ['o'] ["output-dir"] , Option "o" ["output-dir"]
(ReqArg (\str opts -> opts { outDir = str }) "dist/flymake") (ReqArg (\str opts -> opts { outDir = str }) "dist/flymake")
"output directory" "output directory"
] ]
@ -61,7 +61,7 @@ main :: IO ()
main = flip catch handler $ do main = flip catch handler $ do
args <- getArgs args <- getArgs
let (opt,cmdArg) = parseArgs argspec args let (opt,cmdArg) = parseArgs argspec args
res <- case cmdArg !! 0 of res <- case head cmdArg of
"browse" -> browseModule opt (cmdArg !! 1) "browse" -> browseModule opt (cmdArg !! 1)
"list" -> listModules opt "list" -> listModules opt
"check" -> checkSyntax opt (cmdArg !! 1) "check" -> checkSyntax opt (cmdArg !! 1)