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

import           Control.Monad.State.Strict (State)
import qualified Control.Monad.State.Strict as State
import           Data.Fix                   (foldFix)
import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import           Language.Cimple.Ast        (Node)
import qualified Language.Cimple.Flatten    as Flatten
import           Language.Cimple.Lexer      (Lexeme (..), lexemeLine)

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

warn
    :: (HasLocation at, HasDiagnostics diags)
    => FilePath -> at -> Text -> DiagnosticsT diags ()
warn :: FilePath -> at -> Text -> DiagnosticsT diags ()
warn FilePath
file at
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 -> at -> Text
forall a. HasLocation a => FilePath -> a -> Text
sloc FilePath
file at
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w)


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

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


class HasLocation a where
    sloc :: FilePath -> a -> Text

instance HasLocation (Lexeme text) where
    sloc :: FilePath -> Lexeme text -> Text
sloc FilePath
file Lexeme text
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 text -> Int
forall text. Lexeme text -> Int
lexemeLine Lexeme text
l))

instance HasLocation lexeme => HasLocation (Node lexeme) where
    sloc :: FilePath -> Node lexeme -> Text
sloc FilePath
file Node lexeme
n =
        case (NodeF lexeme [lexeme] -> [lexeme]) -> Node lexeme -> [lexeme]
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix NodeF lexeme [lexeme] -> [lexeme]
forall lexeme. NodeF lexeme [lexeme] -> [lexeme]
Flatten.lexemes Node lexeme
n of
            []  -> FilePath -> Text
Text.pack FilePath
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":0:0"
            lexeme
l:[lexeme]
_ -> FilePath -> lexeme -> Text
forall a. HasLocation a => FilePath -> a -> Text
sloc FilePath
file lexeme
l