general parsing for *.cabal!

This commit is contained in:
Kazu Yamamoto 2012-02-06 18:07:32 +09:00
parent 718b3fa3df
commit 36c0b7ac85
2 changed files with 21 additions and 25 deletions

View File

@ -1,14 +1,14 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Cabal (initializeGHC) where module Cabal (initializeGHC) where
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import CoreMonad import CoreMonad
import Data.Attoparsec.ByteString.Char8
import Data.Attoparsec.Enumerator
import Data.Enumerator (run, ($$))
import Data.Enumerator.Binary (enumFile)
import Data.List import Data.List
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Verbosity (silent)
import ErrMsg import ErrMsg
import GHC import GHC
import System.Directory import System.Directory
@ -31,31 +31,28 @@ initializeGHC opt fileName ghcOptions logging = do
midirs <- parseCabalFile cfile midirs <- parseCabalFile cfile
changeToCabalDirectory cdir changeToCabalDirectory cdir
let idirs = case midirs of let idirs = case midirs of
Nothing -> [cdir,owdir] [] -> [cdir,owdir]
Just dirs -> dirs ++ [owdir] dirs -> dirs ++ [owdir]
file = ajustFileName fileName owdir cdir file = ajustFileName fileName owdir cdir
logReader <- initSession opt ghcOptions idirs logging logReader <- initSession opt ghcOptions idirs logging
return (file,logReader) return (file,logReader)
---------------------------------------------------------------- ----------------------------------------------------------------
parseCabalFile :: FilePath -> Ghc (Maybe [String]) parseCabalFile :: FilePath -> Ghc [String]
parseCabalFile file = liftIO $ do parseCabalFile file = do
res <- run (enumFile file $$ iterParser findTarget) cabal <- liftIO $ readPackageDescription silent file
case res of return $ fromLibrary cabal ||| fromExecutable cabal
Right x -> return x where
Left e -> error (show e) [] ||| y = y
x ||| _ = x
findTarget :: Parser (Maybe [String]) fromLibrary c = case condLibrary c of
findTarget = Just <$> hs_source_dirs Nothing -> []
<|> (anyChar >> findTarget) Just lib -> libHsSourceDir lib
<|> Nothing <$ endOfInput libHsSourceDir = hsSourceDirs . libBuildInfo . condTreeData
fromExecutable = execHsSrouceDir . condExecutables
hs_source_dirs :: Parser [String] execHsSrouceDir [] = []
hs_source_dirs = do execHsSrouceDir (x:_) = hsSourceDirs . buildInfo . condTreeData . snd $ x
stringCI "hs-source-dirs:"
many (char ' ')
sepBy1 (many . satisfy $ notInClass " ,\n") (many1 . satisfy $ inClass " ,")
---------------------------------------------------------------- ----------------------------------------------------------------

View File

@ -30,8 +30,7 @@ Executable ghc-mod
GHC-Options: -Wall GHC-Options: -Wall
Build-Depends: base >= 4.0 && < 5, ghc, ghc-paths, transformers, Build-Depends: base >= 4.0 && < 5, ghc, ghc-paths, transformers,
process, directory, filepath, old-time, process, directory, filepath, old-time,
hlint >= 1.7.1, regex-posix, hlint >= 1.7.1, regex-posix, Cabal
attoparsec >= 0.10 , enumerator, attoparsec-enumerator
Source-Repository head Source-Repository head
Type: git Type: git
Location: git://github.com/kazu-yamamoto/ghc-mod.git Location: git://github.com/kazu-yamamoto/ghc-mod.git