{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.Dickinson.Error ( DickinsonError (..)
                                , DickinsonWarning (..)
                                , maybeThrow
                                ) where

import           Control.DeepSeq           (NFData)
import           Control.Exception         (Exception)
import           Control.Monad.Except      (MonadError, throwError)
import           Data.Semigroup            ((<>))
import qualified Data.Text                 as T
import           Data.Typeable             (Typeable)
import           GHC.Generics              (Generic)
import           Language.Dickinson.Name
import           Language.Dickinson.Parser
import           Language.Dickinson.Type
import           Prettyprinter             (Pretty (pretty), dquotes, squotes, (<+>))

data DickinsonError a = UnfoundName a (Name a)
                      | NoText T.Text -- separate from UnfoundName since there is no loc
                      | ParseErr FilePath (ParseError a)
                      | ModuleNotFound a (Name a)
                      | TypeMismatch (Expression a) (DickinsonTy a) (DickinsonTy a)
                      | PatternTypeMismatch (Pattern a) (DickinsonTy a) (DickinsonTy a)
                      | ExpectedLambda (Expression a) (DickinsonTy a)
                      | MultiBind a (Name a) (Pattern a) -- When a variable is bound more than once in a pattern
                      | MalformedTuple a
                      | UnfoundConstructor a (TyName a)
                      | UnfoundType a (Name a)
                      | PatternFail a (Expression a)
                      | SuspectPattern a (Pattern a)
                      deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DickinsonError a) x -> DickinsonError a
forall a x. DickinsonError a -> Rep (DickinsonError a) x
$cto :: forall a x. Rep (DickinsonError a) x -> DickinsonError a
$cfrom :: forall a x. DickinsonError a -> Rep (DickinsonError a) x
Generic, forall a. NFData a => DickinsonError a -> ()
forall a. (a -> ()) -> NFData a
rnf :: DickinsonError a -> ()
$crnf :: forall a. NFData a => DickinsonError a -> ()
NFData)

data DickinsonWarning a = MultipleNames a (Name a) -- TODO: throw both?
                        | DuplicateStr a T.Text
                        | InexhaustiveMatch a
                        | UselessPattern a (Pattern a)
                        deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DickinsonWarning a) x -> DickinsonWarning a
forall a x. DickinsonWarning a -> Rep (DickinsonWarning a) x
$cto :: forall a x. Rep (DickinsonWarning a) x -> DickinsonWarning a
$cfrom :: forall a x. DickinsonWarning a -> Rep (DickinsonWarning a) x
Generic, forall a. NFData a => DickinsonWarning a -> ()
forall a. (a -> ()) -> NFData a
rnf :: DickinsonWarning a -> ()
$crnf :: forall a. NFData a => DickinsonWarning a -> ()
NFData)

maybeThrow :: MonadError e m => Maybe e -> m ()
maybeThrow :: forall e (m :: * -> *). MonadError e m => Maybe e -> m ()
maybeThrow (Just e
err) = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
err
maybeThrow Maybe e
Nothing    = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance (Pretty a) => Show (DickinsonError a) where
    show :: DickinsonError a -> FilePath
show = forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty

instance (Pretty a) => Pretty (DickinsonError a) where
    pretty :: forall ann. DickinsonError a -> Doc ann
pretty (UnfoundName a
l Name a
n)         = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Name a
n) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"is not in scope."
    pretty (NoText Text
t)                = forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Text
t) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"not defined"
    pretty (ParseErr FilePath
_ ParseError a
e)            = forall a ann. Pretty a => a -> Doc ann
pretty ParseError a
e
    pretty (TypeMismatch Expression a
e DickinsonTy a
ty DickinsonTy a
ty')   = forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Expression a -> a
exprAnn Expression a
e) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Expected" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Expression a
e forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"to have type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty DickinsonTy a
ty) forall a. Semigroup a => a -> a -> a
<> Doc ann
", found type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty DickinsonTy a
ty')
    pretty (PatternTypeMismatch Pattern a
p DickinsonTy a
ty DickinsonTy a
ty') = forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Pattern a -> a
patAnn Pattern a
p) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Constructor" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Pattern a
p) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"has type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty DickinsonTy a
ty') forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"but must be of type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty DickinsonTy a
ty)
    pretty (ModuleNotFound a
l Name a
n)      = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Module" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Name a
n) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"not found"
    pretty (ExpectedLambda Expression a
e DickinsonTy a
ty)     = forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Expression a -> a
exprAnn Expression a
e) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Expected" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Expression a
e) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"to be of function type, found type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty DickinsonTy a
ty
    pretty (MultiBind a
l Name a
n Pattern a
p)         = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Name" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Name a
n) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"is bound more than once in" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Pattern a
p
    pretty (MalformedTuple a
l)        = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Malformed tuple"
    pretty (UnfoundConstructor a
l Name a
tn) = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Constructor" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Name a
tn) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"not found"
    pretty (UnfoundType a
l Name a
ty)        = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Type" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Name a
ty) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"not found"
    pretty (PatternFail a
l Expression a
e)         = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Expression" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Expression a
e forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"failed to match"
    pretty (SuspectPattern a
l Pattern a
p)      = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Pattern" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
squotes (forall a ann. Pretty a => a -> Doc ann
pretty Pattern a
p) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"is an or-pattern but it contains a variable."

instance (Pretty a, Typeable a) => Exception (DickinsonError a)

instance (Pretty a) => Show (DickinsonWarning a) where
    show :: DickinsonWarning a -> FilePath
show = forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty

instance (Pretty a) => Pretty (DickinsonWarning a) where
    pretty :: forall ann. DickinsonWarning a -> Doc ann
pretty (MultipleNames a
l Name a
n)   = forall a ann. Pretty a => a -> Doc ann
pretty Name a
n forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"at" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"has already been defined"
    pretty (DuplicateStr a
l Text
t)    = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"duplicate string" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty Text
t)
    pretty (InexhaustiveMatch a
l) = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Inexhaustive match in expression"
    pretty (UselessPattern a
l Pattern a
p)  = forall a ann. Pretty a => a -> Doc ann
pretty a
l forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Pattern" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Pattern a
p forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"is redundant"

instance (Pretty a, Typeable a) => Exception (DickinsonWarning a)