{-# 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 text. FilePath -> Lexeme text -> 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 text -> Text 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)) at :: Node a (Lexeme Text) -> Lexeme Text at :: Node a (Lexeme Text) -> Lexeme Text at Node a (Lexeme Text) n = case (Lexeme Text -> [Lexeme Text]) -> Node a (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 a (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