module Cabal.Info
(
findCabalFile
, findPackageDescription
, findPackageDescription'
, findGenericPackageDescription
, openPackageDescription
, openPackageDescription'
, openGenericPackageDescription
, CabalError(..)
, prettyPrintErr
, evaluateConditions
, getLibrary
, getLibraryModules
, moduleFilePath
) where
import Control.Exception (SomeException, catch)
import Control.Monad (unless)
import Data.Maybe (fromMaybe, listToMaybe)
import Distribution.Compiler
import Distribution.InstalledPackageInfo (PError(..))
import Distribution.ModuleName
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parse
import Distribution.System
import System.FilePath
import System.Directory (getCurrentDirectory, getDirectoryContents)
data CabalError =
NoCabalFile
| ParseError FilePath PError
| NoFlagAssignment (Maybe FilePath)
| NoLibrary FilePath
deriving (Eq, Show)
prettyPrintErr :: CabalError -> String
prettyPrintErr NoCabalFile = "Could not find .cabal file."
prettyPrintErr (ParseError fp err) = "Parse error in " ++ fp ++ ": " ++ show' err ++ "." where
show' (AmbiguousParse _ l) = "ambiguous parse on line " ++ show l
show' (NoParse _ l) = "no parse on line " ++ show l
show' (TabsError l) = "tabbing error on line " ++ show l
show' (FromString _ (Just l)) = "no parse on line " ++ show l
show' (FromString _ Nothing) = "no parse"
prettyPrintErr (NoFlagAssignment (Just fp)) = "Could not find flag assignment for " ++ fp ++ "."
prettyPrintErr (NoFlagAssignment Nothing) = "Could not find flag assignment."
prettyPrintErr (NoLibrary fp) = "Missing library section in " ++ fp ++ "."
findCabalFile :: IO (Maybe FilePath)
findCabalFile = do
cwd <- getCurrentDirectory
listToMaybe <$> findFile ((==".cabal") . takeExtension) (dirs cwd)
where
dirs dir = takeWhile (\d -> takeDirectory d /= d) (iterate takeDirectory dir) ++ [takeDrive dir]
findFile p (d:ds) = (++) <$> (filter p . map (d</>) <$> getDirectoryContents d) <*> findFile p ds
findFile _ [] = pure []
findPackageDescription :: IO (Either CabalError (PackageDescription, FilePath))
findPackageDescription = findPackageDescription' [] Nothing Nothing
findPackageDescription' :: FlagAssignment -> Maybe OS -> Maybe Arch -> IO (Either CabalError (PackageDescription, FilePath))
findPackageDescription' flags os arch = findCabalFile >>=
maybe (pure $ Left NoCabalFile) (\fp -> fmap (,fp) <$> openPackageDescription' flags os arch fp)
findGenericPackageDescription :: IO (Either CabalError (GenericPackageDescription, FilePath))
findGenericPackageDescription = findCabalFile >>=
maybe (pure $ Left NoCabalFile) (\fp -> fmap (,fp) <$> openGenericPackageDescription fp)
openPackageDescription :: FilePath -> IO (Either CabalError PackageDescription)
openPackageDescription = openPackageDescription' [] Nothing Nothing
openPackageDescription' :: FlagAssignment -> Maybe OS -> Maybe Arch -> FilePath -> IO (Either CabalError PackageDescription)
openPackageDescription' flags os arch fp = openGenericPackageDescription fp <$$> \case
Right gpkg -> evaluateConditions flags os arch (Just fp) gpkg
Left err -> Left err
openGenericPackageDescription :: FilePath -> IO (Either CabalError GenericPackageDescription)
openGenericPackageDescription fp = do
cabalFile <- readFile fp
pure $ case parsePackageDescription cabalFile of
ParseOk _ pkg -> Right pkg
ParseFailed err -> Left $ ParseError fp err
evaluateConditions :: FlagAssignment -> Maybe OS -> Maybe Arch -> Maybe FilePath -> GenericPackageDescription -> Either CabalError PackageDescription
evaluateConditions flags os arch fp gpkg = either (const . Left $ NoFlagAssignment fp) (Right . fst) $
finalizePackageDescription flags (const True) platform compiler [] gpkg
where
platform = Platform (fromMaybe buildArch arch) (fromMaybe buildOS os)
compiler = unknownCompilerInfo buildCompilerId NoAbiTag
getLibrary :: IO (Either CabalError Library)
getLibrary = findPackageDescription <$$> \case
Right (pkgd, fp) -> maybe (Left $ NoLibrary fp) Right $ library pkgd
Left err -> Left err
getLibraryModules :: IO (Either CabalError [FilePath])
getLibraryModules = findPackageDescription <$$> \case
Right (pkgd, fp) -> maybe (Left $ NoLibrary fp) (\l -> Right . map (moddir fp l) $ exposedModules l) $ library pkgd
Left err -> Left err
where
moddir fp l m = dropFileName fp </> moduleFilePath (libBuildInfo l) m
moduleFilePath :: BuildInfo -> ModuleName -> FilePath
moduleFilePath b m = joinPath ((fromMaybe "" . listToMaybe $ hsSourceDirs b) : components m) <.> "hs"
(<$$>) :: Functor f => f a -> (a -> b) -> f b
(<$$>) = flip fmap