{-# 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