{-# LANGUAGE DeriveDataTypeable #-}

-- | The types types that we use in Ghcid
module Language.Haskell.Ghcid.Types(
    GhciError(..),
    Stream(..),
    Load(..), Severity(..), EvalResult(..),
    isMessage, isLoading, isLoadConfig
    ) where

import Data.Data
import Control.Exception.Base (Exception)

-- | GHCi shut down
data GhciError = UnexpectedExit
    {GhciError -> String
ghciErrorCmd :: String
    ,GhciError -> String
ghciErrorMsg :: String
    ,GhciError -> Maybe String
ghciErrorLastStdErr :: Maybe String
    }
    deriving (Int -> GhciError -> ShowS
[GhciError] -> ShowS
GhciError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhciError] -> ShowS
$cshowList :: [GhciError] -> ShowS
show :: GhciError -> String
$cshow :: GhciError -> String
showsPrec :: Int -> GhciError -> ShowS
$cshowsPrec :: Int -> GhciError -> ShowS
Show, GhciError -> GhciError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhciError -> GhciError -> Bool
$c/= :: GhciError -> GhciError -> Bool
== :: GhciError -> GhciError -> Bool
$c== :: GhciError -> GhciError -> Bool
Eq, Eq GhciError
GhciError -> GhciError -> Bool
GhciError -> GhciError -> Ordering
GhciError -> GhciError -> GhciError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GhciError -> GhciError -> GhciError
$cmin :: GhciError -> GhciError -> GhciError
max :: GhciError -> GhciError -> GhciError
$cmax :: GhciError -> GhciError -> GhciError
>= :: GhciError -> GhciError -> Bool
$c>= :: GhciError -> GhciError -> Bool
> :: GhciError -> GhciError -> Bool
$c> :: GhciError -> GhciError -> Bool
<= :: GhciError -> GhciError -> Bool
$c<= :: GhciError -> GhciError -> Bool
< :: GhciError -> GhciError -> Bool
$c< :: GhciError -> GhciError -> Bool
compare :: GhciError -> GhciError -> Ordering
$ccompare :: GhciError -> GhciError -> Ordering
Ord, Typeable, Typeable GhciError
GhciError -> DataType
GhciError -> Constr
(forall b. Data b => b -> b) -> GhciError -> GhciError
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GhciError -> u
forall u. (forall d. Data d => d -> u) -> GhciError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GhciError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GhciError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GhciError -> m GhciError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GhciError -> m GhciError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GhciError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GhciError -> c GhciError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GhciError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GhciError)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GhciError -> m GhciError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GhciError -> m GhciError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GhciError -> m GhciError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GhciError -> m GhciError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GhciError -> m GhciError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GhciError -> m GhciError
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GhciError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GhciError -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> GhciError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GhciError -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GhciError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GhciError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GhciError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GhciError -> r
gmapT :: (forall b. Data b => b -> b) -> GhciError -> GhciError
$cgmapT :: (forall b. Data b => b -> b) -> GhciError -> GhciError
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GhciError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GhciError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GhciError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GhciError)
dataTypeOf :: GhciError -> DataType
$cdataTypeOf :: GhciError -> DataType
toConstr :: GhciError -> Constr
$ctoConstr :: GhciError -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GhciError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GhciError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GhciError -> c GhciError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GhciError -> c GhciError
Data)

-- | Make GhciError an exception
instance Exception GhciError

-- | The stream Ghci is talking over.
data Stream = Stdout | Stderr
    deriving (Int -> Stream -> ShowS
[Stream] -> ShowS
Stream -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stream] -> ShowS
$cshowList :: [Stream] -> ShowS
show :: Stream -> String
$cshow :: Stream -> String
showsPrec :: Int -> Stream -> ShowS
$cshowsPrec :: Int -> Stream -> ShowS
Show,Stream -> Stream -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stream -> Stream -> Bool
$c/= :: Stream -> Stream -> Bool
== :: Stream -> Stream -> Bool
$c== :: Stream -> Stream -> Bool
Eq,Eq Stream
Stream -> Stream -> Bool
Stream -> Stream -> Ordering
Stream -> Stream -> Stream
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Stream -> Stream -> Stream
$cmin :: Stream -> Stream -> Stream
max :: Stream -> Stream -> Stream
$cmax :: Stream -> Stream -> Stream
>= :: Stream -> Stream -> Bool
$c>= :: Stream -> Stream -> Bool
> :: Stream -> Stream -> Bool
$c> :: Stream -> Stream -> Bool
<= :: Stream -> Stream -> Bool
$c<= :: Stream -> Stream -> Bool
< :: Stream -> Stream -> Bool
$c< :: Stream -> Stream -> Bool
compare :: Stream -> Stream -> Ordering
$ccompare :: Stream -> Stream -> Ordering
Ord,Stream
forall a. a -> a -> Bounded a
maxBound :: Stream
$cmaxBound :: Stream
minBound :: Stream
$cminBound :: Stream
Bounded,Int -> Stream
Stream -> Int
Stream -> [Stream]
Stream -> Stream
Stream -> Stream -> [Stream]
Stream -> Stream -> Stream -> [Stream]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Stream -> Stream -> Stream -> [Stream]
$cenumFromThenTo :: Stream -> Stream -> Stream -> [Stream]
enumFromTo :: Stream -> Stream -> [Stream]
$cenumFromTo :: Stream -> Stream -> [Stream]
enumFromThen :: Stream -> Stream -> [Stream]
$cenumFromThen :: Stream -> Stream -> [Stream]
enumFrom :: Stream -> [Stream]
$cenumFrom :: Stream -> [Stream]
fromEnum :: Stream -> Int
$cfromEnum :: Stream -> Int
toEnum :: Int -> Stream
$ctoEnum :: Int -> Stream
pred :: Stream -> Stream
$cpred :: Stream -> Stream
succ :: Stream -> Stream
$csucc :: Stream -> Stream
Enum,ReadPrec [Stream]
ReadPrec Stream
Int -> ReadS Stream
ReadS [Stream]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Stream]
$creadListPrec :: ReadPrec [Stream]
readPrec :: ReadPrec Stream
$creadPrec :: ReadPrec Stream
readList :: ReadS [Stream]
$creadList :: ReadS [Stream]
readsPrec :: Int -> ReadS Stream
$creadsPrec :: Int -> ReadS Stream
Read,Typeable,Typeable Stream
Stream -> DataType
Stream -> Constr
(forall b. Data b => b -> b) -> Stream -> Stream
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Stream -> u
forall u. (forall d. Data d => d -> u) -> Stream -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stream -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stream -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stream -> m Stream
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stream -> m Stream
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stream
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stream -> c Stream
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stream)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stream)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stream -> m Stream
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stream -> m Stream
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stream -> m Stream
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stream -> m Stream
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stream -> m Stream
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stream -> m Stream
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Stream -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Stream -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Stream -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Stream -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stream -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stream -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stream -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stream -> r
gmapT :: (forall b. Data b => b -> b) -> Stream -> Stream
$cgmapT :: (forall b. Data b => b -> b) -> Stream -> Stream
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stream)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stream)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stream)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stream)
dataTypeOf :: Stream -> DataType
$cdataTypeOf :: Stream -> DataType
toConstr :: Stream -> Constr
$ctoConstr :: Stream -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stream
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stream
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stream -> c Stream
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stream -> c Stream
Data)

-- | Severity of messages
data Severity = Warning | Error
    deriving (Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show,Severity -> Severity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq,Eq Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c< :: Severity -> Severity -> Bool
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
Ord,Severity
forall a. a -> a -> Bounded a
maxBound :: Severity
$cmaxBound :: Severity
minBound :: Severity
$cminBound :: Severity
Bounded,Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [Severity]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFrom :: Severity -> [Severity]
fromEnum :: Severity -> Int
$cfromEnum :: Severity -> Int
toEnum :: Int -> Severity
$ctoEnum :: Int -> Severity
pred :: Severity -> Severity
$cpred :: Severity -> Severity
succ :: Severity -> Severity
$csucc :: Severity -> Severity
Enum,ReadPrec [Severity]
ReadPrec Severity
Int -> ReadS Severity
ReadS [Severity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Severity]
$creadListPrec :: ReadPrec [Severity]
readPrec :: ReadPrec Severity
$creadPrec :: ReadPrec Severity
readList :: ReadS [Severity]
$creadList :: ReadS [Severity]
readsPrec :: Int -> ReadS Severity
$creadsPrec :: Int -> ReadS Severity
Read,Typeable,Typeable Severity
Severity -> DataType
Severity -> Constr
(forall b. Data b => b -> b) -> Severity -> Severity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Severity -> u
forall u. (forall d. Data d => d -> u) -> Severity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Severity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Severity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Severity -> m Severity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Severity -> m Severity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Severity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Severity -> c Severity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Severity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Severity)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Severity -> m Severity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Severity -> m Severity
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Severity -> m Severity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Severity -> m Severity
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Severity -> m Severity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Severity -> m Severity
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Severity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Severity -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Severity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Severity -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Severity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Severity -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Severity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Severity -> r
gmapT :: (forall b. Data b => b -> b) -> Severity -> Severity
$cgmapT :: (forall b. Data b => b -> b) -> Severity -> Severity
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Severity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Severity)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Severity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Severity)
dataTypeOf :: Severity -> DataType
$cdataTypeOf :: Severity -> DataType
toConstr :: Severity -> Constr
$ctoConstr :: Severity -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Severity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Severity
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Severity -> c Severity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Severity -> c Severity
Data)

-- | Load messages
data Load
    = -- | A module/file was being loaded.
      Loading
        {Load -> String
loadModule :: String -- ^ The module that was being loaded, @Foo.Bar@.
        ,Load -> String
loadFile :: FilePath -- ^ The file that was being loaded, @Foo/Bar.hs@.
        }
    | -- | An error/warning was emitted.
      Message
        {Load -> Severity
loadSeverity :: Severity -- ^ The severity of the message, either 'Warning' or 'Error'.
        ,loadFile :: FilePath -- ^ The file the error relates to, @Foo/Bar.hs@.
        ,Load -> (Int, Int)
loadFilePos :: (Int,Int) -- ^ The position in the file, @(line,col)@, both 1-based. Uses @(0,0)@ for no position information.
        ,Load -> (Int, Int)
loadFilePosEnd :: (Int, Int) -- ^ The end position in the file, @(line,col)@, both 1-based. If not present will be the same as 'loadFilePos'.
        ,Load -> [String]
loadMessage :: [String] -- ^ The message, split into separate lines, may contain ANSI Escape codes.
        }
    | -- | A config file was loaded, usually a .ghci file (GHC 8.2 and above only)
      LoadConfig
        {loadFile :: FilePath -- ^ The file that was being loaded, @.ghci@.
        }
    | -- | A response to an eval comment
      Eval EvalResult
    deriving (Int -> Load -> ShowS
[Load] -> ShowS
Load -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Load] -> ShowS
$cshowList :: [Load] -> ShowS
show :: Load -> String
$cshow :: Load -> String
showsPrec :: Int -> Load -> ShowS
$cshowsPrec :: Int -> Load -> ShowS
Show, Load -> Load -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Load -> Load -> Bool
$c/= :: Load -> Load -> Bool
== :: Load -> Load -> Bool
$c== :: Load -> Load -> Bool
Eq, Eq Load
Load -> Load -> Bool
Load -> Load -> Ordering
Load -> Load -> Load
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Load -> Load -> Load
$cmin :: Load -> Load -> Load
max :: Load -> Load -> Load
$cmax :: Load -> Load -> Load
>= :: Load -> Load -> Bool
$c>= :: Load -> Load -> Bool
> :: Load -> Load -> Bool
$c> :: Load -> Load -> Bool
<= :: Load -> Load -> Bool
$c<= :: Load -> Load -> Bool
< :: Load -> Load -> Bool
$c< :: Load -> Load -> Bool
compare :: Load -> Load -> Ordering
$ccompare :: Load -> Load -> Ordering
Ord)

data EvalResult = EvalResult
    {EvalResult -> String
evalFile :: FilePath -- ^ The file that was being loaded, @.ghci@.
    ,EvalResult -> (Int, Int)
evalFilePos :: (Int, Int)
    ,EvalResult -> String
evalCommand :: String
    ,EvalResult -> String
evalResult :: String
    }
    deriving (Int -> EvalResult -> ShowS
[EvalResult] -> ShowS
EvalResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalResult] -> ShowS
$cshowList :: [EvalResult] -> ShowS
show :: EvalResult -> String
$cshow :: EvalResult -> String
showsPrec :: Int -> EvalResult -> ShowS
$cshowsPrec :: Int -> EvalResult -> ShowS
Show, EvalResult -> EvalResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvalResult -> EvalResult -> Bool
$c/= :: EvalResult -> EvalResult -> Bool
== :: EvalResult -> EvalResult -> Bool
$c== :: EvalResult -> EvalResult -> Bool
Eq, Eq EvalResult
EvalResult -> EvalResult -> Bool
EvalResult -> EvalResult -> Ordering
EvalResult -> EvalResult -> EvalResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EvalResult -> EvalResult -> EvalResult
$cmin :: EvalResult -> EvalResult -> EvalResult
max :: EvalResult -> EvalResult -> EvalResult
$cmax :: EvalResult -> EvalResult -> EvalResult
>= :: EvalResult -> EvalResult -> Bool
$c>= :: EvalResult -> EvalResult -> Bool
> :: EvalResult -> EvalResult -> Bool
$c> :: EvalResult -> EvalResult -> Bool
<= :: EvalResult -> EvalResult -> Bool
$c<= :: EvalResult -> EvalResult -> Bool
< :: EvalResult -> EvalResult -> Bool
$c< :: EvalResult -> EvalResult -> Bool
compare :: EvalResult -> EvalResult -> Ordering
$ccompare :: EvalResult -> EvalResult -> Ordering
Ord)

-- | Is a 'Load' a 'Message'?
isMessage :: Load -> Bool
isMessage :: Load -> Bool
isMessage Message{} = Bool
True
isMessage Load
_ = Bool
False

-- | Is a 'Load' a 'Loading'?
isLoading :: Load -> Bool
isLoading :: Load -> Bool
isLoading Loading{} = Bool
True
isLoading Load
_ = Bool
False

-- | Is a 'Load' a 'LoadConfig'?
isLoadConfig :: Load -> Bool
isLoadConfig :: Load -> Bool
isLoadConfig LoadConfig{} = Bool
True
isLoadConfig Load
_ = Bool
False