module HaskellCI.ParsecUtils where

import HaskellCI.Prelude

import System.Directory (doesFileExist)
import System.Exit      (exitFailure)
import System.IO        (hPutStr, stderr)

import qualified Data.ByteString                as BS
import qualified Distribution.Fields            as C
import qualified Distribution.Fields.LexerMonad as C (toPWarnings)
import qualified Distribution.Parsec            as C
import qualified Text.Parsec                    as P

import Cabal.Parse

readAndParseFile
    :: ([C.Field C.Position] -> C.ParseResult a)  -- ^ File fields to final value parser
    -> FilePath                                   -- ^ File to read
    -> IO a
readAndParseFile :: forall a. ([Field Position] -> ParseResult a) -> FilePath -> IO a
readAndParseFile [Field Position] -> ParseResult a
parser FilePath
fpath = do
    Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
fpath
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Error Parsing: file \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fpath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\" doesn't exist. Cannot continue."
        IO ()
forall a. IO a
exitFailure
    ByteString
bs <- FilePath -> IO ByteString
BS.readFile FilePath
fpath
    ByteString -> ParseResult a -> IO a
forall a. ByteString -> ParseResult a -> IO a
run ByteString
bs (ParseResult a -> IO a) -> ParseResult a -> IO a
forall a b. (a -> b) -> a -> b
$ case ByteString -> Either ParseError ([Field Position], [LexWarning])
C.readFields' ByteString
bs of
        Right ([Field Position]
fs, [LexWarning]
lexWarnings) -> do
            [PWarning] -> ParseResult ()
C.parseWarnings ([LexWarning] -> [PWarning]
C.toPWarnings [LexWarning]
lexWarnings)
            [Field Position] -> ParseResult a
parser [Field Position]
fs
        Left ParseError
perr -> Position -> FilePath -> ParseResult a
forall a. Position -> FilePath -> ParseResult a
C.parseFatalFailure Position
pos (ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
perr) where
            ppos :: SourcePos
ppos = ParseError -> SourcePos
P.errorPos ParseError
perr
            pos :: Position
pos  = Int -> Int -> Position
C.Position (SourcePos -> Int
P.sourceLine SourcePos
ppos) (SourcePos -> Int
P.sourceColumn SourcePos
ppos)
  where
    run :: BS.ByteString -> C.ParseResult a -> IO a
    run :: forall a. ByteString -> ParseResult a -> IO a
run ByteString
bs ParseResult a
r = case ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
C.runParseResult ParseResult a
r of
        ([PWarning]
ws, Right a
x)      -> do
            Handle -> FilePath -> IO ()
hPutStr Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ ParseError [] -> FilePath
forall (f :: * -> *). Foldable f => ParseError f -> FilePath
renderParseError (FilePath -> ByteString -> [PError] -> [PWarning] -> ParseError []
forall (f :: * -> *).
FilePath -> ByteString -> f PError -> [PWarning] -> ParseError f
ParseError FilePath
fpath ByteString
bs [] [PWarning]
ws)
            a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        ([PWarning]
ws, Left (Maybe Version
_, NonEmpty PError
es)) -> do
            Handle -> FilePath -> IO ()
hPutStr Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ ParseError [] -> FilePath
forall (f :: * -> *). Foldable f => ParseError f -> FilePath
renderParseError (FilePath -> ByteString -> [PError] -> [PWarning] -> ParseError []
forall (f :: * -> *).
FilePath -> ByteString -> f PError -> [PWarning] -> ParseError f
ParseError FilePath
fpath ByteString
bs (NonEmpty PError -> [PError]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty PError
es) [PWarning]
ws)
            IO a
forall a. IO a
exitFailure