{-# Language PatternGuards, CPP #-}
module CabalCargs.Spec
( Spec(..)
, fromCmdArgs
) where
import Distribution.PackageDescription (GenericPackageDescription)
import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, runParseResult)
import Distribution.Parsec.Common (PWarning)
import qualified Distribution.System as Sys
import CabalCargs.Args (Args)
import qualified CabalCargs.Args as A
import qualified CabalCargs.Fields as F
import qualified CabalLenses as CL
import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)
import Control.Monad.IO.Class
import Control.Lens
import System.Directory (getCurrentDirectory)
import qualified Filesystem.Path.CurrentOS as FP
import Filesystem.Path.CurrentOS ((</>))
import qualified Filesystem as FS
import Data.List ((\\))
import qualified Data.List as L
import Data.Maybe (isJust)
import qualified Data.ByteString as BS
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
data Spec = Spec
{ sections :: [CL.Section]
, fields :: F.Fields
, condVars :: CL.CondVars
, pkgDescrp :: GenericPackageDescription
, cabalFile :: FilePath
, distDir :: Maybe FilePath
, packageDB :: Maybe FilePath
, relativePaths :: Bool
}
type Error = String
io :: MonadIO m => IO a -> m a
io = liftIO
fromCmdArgs :: Args -> IO (Either Error Spec)
fromCmdArgs args
| Just cabalFile <- A.cabalFile args = runExceptT $ do
spec <- fromCabalFile cabalFile
srcSections <- io $ case A.sourceFile args of
Just srcFile -> findSections srcFile cabalFile (pkgDescrp spec)
_ -> return []
return $ applyCondVars $ spec { sections = combineSections (args, pkgDescrp spec) srcSections
, fields = fields_ args
, relativePaths = A.relative args
}
| Just sourceFile <- A.sourceFile args = runExceptT $ do
spec <- fromSourceFile sourceFile
return $ applyCondVars $ spec { sections = combineSections (args, pkgDescrp spec) (sections spec)
, fields = fields_ args
, relativePaths = A.relative args
}
| otherwise = runExceptT $ do
curDir <- io getCurrentDirectory
cabalFile <- CL.findCabalFile curDir
spec <- fromCabalFile cabalFile
return $ applyCondVars $ spec { sections = sections_ args (pkgDescrp spec)
, fields = fields_ args
, relativePaths = A.relative args
}
where
applyCondVars = applyFlags args . applyOS args . applyArch args
fromCabalFile :: FilePath -> ExceptT Error IO Spec
fromCabalFile file = do
pkgDescrp <- packageDescription file
pkgDB <- CL.findPackageDB file
distDir <- io $ CL.findDistDir file
absFile <- FP.encodeString <$> io (absoluteFile file)
return $ Spec
{ sections = CL.allSections pkgDescrp
, fields = F.allFields
, condVars = CL.fromDefaults pkgDescrp
, pkgDescrp = pkgDescrp
, cabalFile = absFile
, distDir = distDir
, packageDB = pkgDB
, relativePaths = False
}
fromSourceFile :: FilePath -> ExceptT Error IO Spec
fromSourceFile file = do
cabalFile <- CL.findCabalFile file
pkgDB <- CL.findPackageDB cabalFile
distDir <- io $ CL.findDistDir cabalFile
pkgDescrp <- packageDescription cabalFile
srcSections <- io $ findSections file cabalFile pkgDescrp
return $ Spec
{ sections = srcSections
, fields = F.allFields
, condVars = CL.fromDefaults pkgDescrp
, pkgDescrp = pkgDescrp
, cabalFile = cabalFile
, distDir = distDir
, packageDB = pkgDB
, relativePaths = False
}
applyFlags :: Args -> Spec -> Spec
applyFlags args spec =
spec { condVars = disableFlags . enableFlags $ condVars spec }
where
disableFlags condVars = foldr CL.disableFlag condVars (A.disable args)
enableFlags condVars = foldr CL.enableFlag condVars (A.enable args)
applyOS :: Args -> Spec -> Spec
applyOS (A.Args { A.os = os }) spec
| Just str <- os
, [(name, _)] <- reads str :: [(Sys.OS, String)]
= setOS name
| Just str <- os
= setOS $ Sys.OtherOS str
| otherwise
= spec
where
setOS name = spec { condVars = (condVars spec) { CL.os = name } }
applyArch :: Args -> Spec -> Spec
applyArch (A.Args { A.arch = arch }) spec
| Just str <- arch
, [(name, _)] <- reads str :: [(Sys.Arch, String)]
= setArch name
| Just str <- arch
= setArch $ Sys.OtherArch str
| otherwise
= spec
where
setArch name = spec { condVars = (condVars spec) { CL.arch = name } }
packageDescription :: FilePath -> ExceptT Error IO GenericPackageDescription
packageDescription file = do
contents <- io $ BS.readFile file
let (warnings, result) = runParseResult $ parseGenericPackageDescription contents
io $ showWarnings warnings
case result of
Left (_, errors) -> throwE $ show errors
Right pkgDescrp -> return pkgDescrp
where
showWarnings :: [PWarning] -> IO ()
showWarnings [] = return ()
showWarnings ws = putStrLn $ "cabal-cargs: " ++ (L.intercalate ", " $ map show ws)
findSections :: FilePath -> FilePath -> GenericPackageDescription -> IO [CL.Section]
findSections srcFile cabalFile pkgDescrp = do
absSrcFile <- absoluteFile srcFile
cabalDir <- absoluteDirectory cabalFile
let sections = filter (fittingSection absSrcFile cabalDir) (allHsSourceDirs pkgDescrp)
return $ map fst sections
where
fittingSection srcFile cabalDir (_, []) =
isJust $ FP.stripPrefix (cabalDir </> FP.empty) srcFile
fittingSection srcFile cabalDir (_, srcDirs) = any samePrefix srcDirs
where samePrefix srcDir = isJust $ FP.stripPrefix (cabalDir </> srcDir </> FP.empty) srcFile
type HsSourceDirs = [FP.FilePath]
allHsSourceDirs :: GenericPackageDescription -> [(CL.Section, HsSourceDirs)]
allHsSourceDirs pkgDescrp = zip sections hsSourceDirs
where
sections = CL.allSections pkgDescrp
hsSourceDirs = map (\section -> toFPs $ pkgDescrp ^. CL.buildInfoIf condVars section . CL.hsSourceDirsL) sections
where
toFPs = map FP.decodeString
condVars = CL.fromDefaults pkgDescrp
absoluteDirectory :: FilePath -> IO FP.FilePath
absoluteDirectory file = do
absFile <- absoluteFile file
isDir <- FS.isDirectory absFile
if isDir
then return absFile
else return . FP.directory $ absFile
absoluteFile :: FilePath -> IO FP.FilePath
absoluteFile = FS.canonicalizePath . FP.decodeString
combineSections :: (Args, GenericPackageDescription) -> [CL.Section] -> [CL.Section]
combineSections (args, pkgDescrp) sections
| A.allSections args
= CL.allSections pkgDescrp
| [] <- explicitSections args
, null sections
= CL.allSections pkgDescrp
| otherwise
= L.nub $ explicitSections args ++ sections
fields_ :: Args -> F.Fields
fields_ args
| fs@(_:_) <- A.only args
= fs
| fs@(_:_) <- A.ignore args
= F.allFields \\ fs
| otherwise
= F.allFields
sections_ :: Args -> GenericPackageDescription -> [CL.Section]
sections_ args pkgDescrp
| A.allSections args
= CL.allSections pkgDescrp
| ss@(_:_) <- explicitSections args
= ss
| otherwise
= CL.allSections pkgDescrp
explicitSections :: Args -> [CL.Section]
explicitSections args =
concat [ [CL.Library | A.library args]
, map CL.Executable (A.executable args)
, map CL.TestSuite (A.testSuite args)
, map CL.Benchmark (A.benchmark args)
]