module Parse
( parsePackageDescription
, readPackageDescription
, displayError
, printWarnings
, Result(..)
, result
) where
import Control.DeepSeq
import Data.Data
import Data.Maybe
import Distribution.PackageDescription.Parse (parseGenericPackageDescription)
import Distribution.ParseUtils
import Distribution.Simple.Utils
import Distribution.Verbosity
import GHC.Generics
import Prelude.Compat
import System.Environment
import System.Exit
import System.IO
#if MIN_VERSION_base(4,9,0)
import Data.Functor.Classes
#endif
data Result a
= Error (Maybe LineNo)
String
| Warn [PWarning]
| Success a
deriving (Show, Eq, Functor, Generic, Typeable, Data)
#if MIN_VERSION_base(4,6,0)
deriving instance Generic1 Result
#endif
#if MIN_VERSION_base(4,9,0)
instance Show1 Result where
liftShowsPrec sp _ p (Success n) = showsUnaryWith sp "Success" p n
liftShowsPrec _ _ p (Warn pws) = showsUnaryWith showsPrec "Warn" p pws
liftShowsPrec _ _ p (Error ml s) = showsBinaryWith showsPrec showsPrec "Error" p ml s
instance Eq1 Result where
liftEq eq (Success a) (Success b) = eq a b
liftEq _ (Error ml s) (Error ml2 s2) = (ml,s) == (ml2,s2)
liftEq _ (Warn pws) (Warn pws2) = pws == pws2
liftEq _ _ _ = False
#endif
result :: (Maybe LineNo -> String -> b) -> ([PWarning] -> b) -> (a -> b) -> Result a -> b
result e w s p =
case p of
Error l m -> e l m
Warn ws -> w ws
Success r -> s r
instance NFData a => NFData (Result a)
deriving instance Generic PWarning
deriving instance Data PWarning
deriving instance Typeable PWarning
instance NFData PWarning
parsePackageDescription input =
case parseGenericPackageDescription input of
ParseFailed e -> uncurry Error $ locatedErrorMsg e
ParseOk warnings x
| null warnings -> Success x
| otherwise -> Warn $ reverse warnings
readPackageDescription fpath =
result (displayError fpath) (printWarnings fpath) return . parsePackageDescription
printWarnings :: Maybe FilePath -> [PWarning] -> IO a
printWarnings fpath ps =
mapM_ (warn normal . showPWarning (fromMaybe "<input>" fpath)) ps >> exitFailure
displayError :: Maybe FilePath -> Maybe LineNo -> String -> IO a
displayError fpath line' message = do
prog <- getProgName
hPutStrLn stderr $
prog ++
": " ++
fromMaybe "<input>" fpath ++
(case line' of
Just lineno -> ":" ++ show lineno
Nothing -> "") ++
": " ++ message
exitFailure