{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
module Language.Cimple.Diagnostics
  ( Diagnostics
  , HasDiagnostics (..)
  , warn
  , sloc
  , at
  ) where

import           Control.Monad.State.Lazy (State)
import qualified Control.Monad.State.Lazy as State
import           Data.Text                (Text)
import qualified Data.Text                as Text
import           Language.Cimple.AST      (Node)
import           Language.Cimple.Lexer    (AlexPosn (..), Lexeme (..),
                                           lexemeLine)
import           Language.Cimple.Tokens   (LexemeClass (..))

type DiagnosticsT diags a = State diags a
type Diagnostics a = DiagnosticsT [Text] a


class HasDiagnostics a where
    addDiagnostic :: Text -> a -> a

instance HasDiagnostics [Text] where
    addDiagnostic :: Text -> [Text] -> [Text]
addDiagnostic = (:)


warn :: HasDiagnostics diags => FilePath -> Lexeme Text -> Text -> DiagnosticsT diags ()
warn :: FilePath -> Lexeme Text -> Text -> DiagnosticsT diags ()
warn FilePath
file Lexeme Text
l Text
w = (diags -> diags) -> DiagnosticsT diags ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Text -> diags -> diags
forall a. HasDiagnostics a => Text -> a -> a
addDiagnostic (Text -> diags -> diags) -> Text -> diags -> diags
forall a b. (a -> b) -> a -> b
$ FilePath -> Lexeme Text -> Text
forall a. FilePath -> Lexeme a -> Text
sloc FilePath
file Lexeme Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w)


sloc :: FilePath -> Lexeme a -> Text
sloc :: FilePath -> Lexeme a -> Text
sloc FilePath
file Lexeme a
l = FilePath -> Text
Text.pack FilePath
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Lexeme a -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme a
l))


at :: Node (Lexeme Text) -> Lexeme Text
at :: Node (Lexeme Text) -> Lexeme Text
at Node (Lexeme Text)
n =
    case (Lexeme Text -> [Lexeme Text])
-> Node (Lexeme Text) -> [Lexeme Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Lexeme Text -> [Lexeme Text] -> [Lexeme Text]
forall a. a -> [a] -> [a]
:[]) Node (Lexeme Text)
n of
        []  -> AlexPosn -> LexemeClass -> Text -> Lexeme Text
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L (Int -> Int -> Int -> AlexPosn
AlexPn Int
0 Int
0 Int
0) LexemeClass
Error Text
"unknown source location"
        Lexeme Text
l:[Lexeme Text]
_ -> Lexeme Text
l