{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE StandaloneDeriving #-}

module Language.ATS.Generate.Error ( -- * Types
                                     GenerateError (..)
                                   , ErrM
                                   -- * Functions
                                   , displayErr
                                   -- * Helper functions
                                   , unsupported
                                   , syntaxError
                                   ) where

import           Control.Composition
import           Control.DeepSeq              (NFData)
import           GHC.Generics                 (Generic)
import           Language.Haskell.Exts        hiding (Pretty, loc)
import           System.IO                    (stderr)
import           Text.PrettyPrint.ANSI.Leijen

deriving instance NFData SrcLoc

displayErr :: GenerateError -> IO ()
displayErr = hPutDoc stderr . pretty

type ErrM a = Either GenerateError a

syntaxError :: SrcLoc -> String -> ErrM a
syntaxError = Left .* HaskellSyntaxError

unsupported :: String -> ErrM a
unsupported = Left . Unsupported

data GenerateError = Unsupported String
                   | HaskellSyntaxError SrcLoc String
                   | Internal String
                   deriving (Eq, Show, Generic, NFData)

instance Pretty GenerateError where
    pretty (Unsupported s)            = dullyellow "Warning:" <+> "skipping unsupported construct" <$$> indent 2 (squotes (text s)) <> linebreak
    pretty (HaskellSyntaxError loc s) = red "Error:" <+> "failed to parse" <+> text (show loc) <> colon <$$> indent 2 (text s) <> linebreak
    pretty (Internal s)               = red "Error:" <+> "internal error: " <$$> indent 2 (text s) <> linebreak