hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

pure and applicative style.

Browse Source
This commit is contained in:
Kazu Yamamoto 2013-03-05 10:21:55 +09:00
parent 5b6924d36a
commit b7cacee767
1 changed files with 31 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
CabalApi.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings, RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}
module CabalApi ( module CabalApi (
fromCabalFile fromCabalFile
@ -30,28 +30,24 @@ import Types
fromCabalFile :: [GHCOption] fromCabalFile :: [GHCOption]
-> Cradle -> Cradle
-> IO ([GHCOption] -> IO ([GHCOption],[IncludeDir],[Package],[LangExt])
,[IncludeDir] fromCabalFile ghcOptions cradle =
,[Package] cookInfo ghcOptions cradle <$> cabalParseFile cfile
,[LangExt]) where
fromCabalFile ghcOptions cradle = do Just cfile = cradleCabalFile cradle
cabal <- cabalParseFile cfile
let binfo@BuildInfo{..} = cabalBuildInfo cabal cookInfo :: [String] -> Cradle -> GenericPackageDescription
let exts = map (("-X" ++) . display) $ usedExtensions binfo -> ([GHCOption],[IncludeDir],[Package],[LangExt])
lang = maybe "-XHaskell98" (("-X" ++) . display) defaultLanguage cookInfo ghcOptions cradle cabal = (gopts,idirs,depPkgs,hdrExts)
libs = map ("-l" ++) extraLibs
libDirs = map ("-L" ++) extraLibDirs
gopts = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs
idirs = case hsSourceDirs of
[] -> [cdir,owdir]
dirs -> map (cdir </>) dirs ++ [owdir]
let depPkgs = removeMe cfile $ cabalAllDependPackages cabal
hdrExts = cabalAllExtentions cabal
return (gopts,idirs,depPkgs,hdrExts)
where where
owdir = cradleCurrentDir cradle owdir = cradleCurrentDir cradle
Just cdir = cradleCabalDir cradle Just cdir = cradleCabalDir cradle
Just cfile = cradleCabalFile cradle Just cfile = cradleCabalFile cradle
binfo = cabalBuildInfo cabal
gopts = getGHCOptions ghcOptions binfo
idirs = includeDirectroies cdir owdir $ hsSourceDirs binfo
depPkgs = removeMe cfile $ cabalAllDependPackages cabal
hdrExts = cabalAllExtentions cabal
removeMe :: FilePath -> [String] -> [String] removeMe :: FilePath -> [String] -> [String]
removeMe cabalfile = filter (/= me) removeMe cabalfile = filter (/= me)
@ -65,6 +61,16 @@ cabalParseFile = readPackageDescription silent
---------------------------------------------------------------- ----------------------------------------------------------------
getGHCOptions :: [String] -> BuildInfo -> [String]
getGHCOptions ghcOptions binfo = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs
where
exts = map (("-X" ++) . display) $ usedExtensions binfo
lang = maybe "-XHaskell98" (("-X" ++) . display) $ defaultLanguage binfo
libs = map ("-l" ++) $ extraLibs binfo
libDirs = map ("-L" ++) $ extraLibDirs binfo
----------------------------------------------------------------
-- Causes error, catched in the upper function. -- Causes error, catched in the upper function.
cabalBuildInfo :: GenericPackageDescription -> BuildInfo cabalBuildInfo :: GenericPackageDescription -> BuildInfo
cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd
@ -133,6 +139,12 @@ fromPackageDescription f1 f2 f3 f4 pd = lib ++ exe ++ tests ++ bench
---------------------------------------------------------------- ----------------------------------------------------------------
includeDirectroies :: String -> String -> [FilePath] -> [String]
includeDirectroies cdir owdir [] = uniqueAndSort [cdir,owdir]
includeDirectroies cdir owdir dirs = uniqueAndSort (map (cdir </>) dirs ++ [owdir])
----------------------------------------------------------------
uniqueAndSort :: [String] -> [String] uniqueAndSort :: [String] -> [String]
uniqueAndSort = toList . fromList uniqueAndSort = toList . fromList