{-# LANGUAGE OverloadedStrings #-}

module Language.ATS.Package.Error ( -- * Helper functions
                                    unrecognized
                                  , resolutionFailed
                                  -- * Types
                                  , PackageError (..)
                                  ) where

import           Data.Dependency
import           Quaalude
import           System.Exit

unrecognized :: String -> IO a
unrecognized :: String -> IO a
unrecognized = PackageError -> IO a
forall a. PackageError -> IO a
printErr (PackageError -> IO a)
-> (String -> PackageError) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PackageError
Unrecognized

resolutionFailed :: ResolveError -> IO a
resolutionFailed :: ResolveError -> IO a
resolutionFailed = PackageError -> IO a
forall a. PackageError -> IO a
printErr (PackageError -> IO a)
-> (ResolveError -> PackageError) -> ResolveError -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolveError -> PackageError
DepErr

data PackageError = Unrecognized String
                  | DepErr ResolveError

instance Pretty PackageError where
    pretty :: PackageError -> Doc
pretty (Unrecognized String
t) = Doc -> Doc
dullred Doc
"Error:" Doc -> Doc -> Doc
<+> Doc
"Unrecognized archive format when unpacking" Doc -> Doc -> Doc
<#> Int -> Doc -> Doc
hang Int
2 (String -> Doc
text String
t) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
linebreak
    pretty (DepErr ResolveError
d)       = ResolveError -> Doc
forall a. Pretty a => a -> Doc
pretty ResolveError
d

-- TODO monaderror?
printErr :: PackageError -> IO a
printErr :: PackageError -> IO a
printErr PackageError
e = Doc -> IO ()
putDoc (PackageError -> Doc
forall a. Pretty a => a -> Doc
pretty PackageError
e) IO () -> IO a -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO a
forall a. IO a
exitFailure