module Cabal.Package (
    readPackage,
    parsePackage,
    ) where

import Control.Exception            (throwIO)
import Data.ByteString              (ByteString)
import Data.List.NonEmpty           (NonEmpty)

import qualified Data.ByteString                        as BS
import qualified Distribution.Fields                    as C
import qualified Distribution.PackageDescription        as C
import qualified Distribution.PackageDescription.Parsec as C

import Cabal.Parse

-- | High level convinience function to read package definitons, @.cabal@ files.
--
-- May throw 'IOException' when file doesn't exist, and 'ParseError'
-- on parse error.
readPackage :: FilePath -> IO C.GenericPackageDescription
readPackage :: FilePath -> IO GenericPackageDescription
readPackage FilePath
fp = do
    ByteString
contents <- FilePath -> IO ByteString
BS.readFile FilePath
fp
    (ParseError NonEmpty -> IO GenericPackageDescription)
-> (GenericPackageDescription -> IO GenericPackageDescription)
-> Either (ParseError NonEmpty) GenericPackageDescription
-> IO GenericPackageDescription
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError NonEmpty -> IO GenericPackageDescription
forall e a. Exception e => e -> IO a
throwIO GenericPackageDescription -> IO GenericPackageDescription
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
-> ByteString
-> Either (ParseError NonEmpty) GenericPackageDescription
parsePackage FilePath
fp ByteString
contents)

-- | Parse @.cabal@ file.
parsePackage :: FilePath -> ByteString -> Either (ParseError NonEmpty) C.GenericPackageDescription
parsePackage :: FilePath
-> ByteString
-> Either (ParseError NonEmpty) GenericPackageDescription
parsePackage FilePath
fp ByteString
contents = case ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
C.runParseResult (ParseResult GenericPackageDescription
 -> ([PWarning],
     Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseResult GenericPackageDescription
C.parseGenericPackageDescription ByteString
contents of
    ([PWarning]
ws, Left (Maybe Version
_mv, NonEmpty PError
errs)) -> ParseError NonEmpty
-> Either (ParseError NonEmpty) GenericPackageDescription
forall a b. a -> Either a b
Left (ParseError NonEmpty
 -> Either (ParseError NonEmpty) GenericPackageDescription)
-> ParseError NonEmpty
-> Either (ParseError NonEmpty) GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ FilePath
-> ByteString
-> NonEmpty PError
-> [PWarning]
-> ParseError NonEmpty
forall (f :: * -> *).
FilePath -> ByteString -> f PError -> [PWarning] -> ParseError f
ParseError FilePath
fp ByteString
contents NonEmpty PError
errs [PWarning]
ws
    ([PWarning]
_, Right GenericPackageDescription
gpd)         -> GenericPackageDescription
-> Either (ParseError NonEmpty) GenericPackageDescription
forall a b. b -> Either a b
Right GenericPackageDescription
gpd