{-# LANGUAGE OverloadedStrings #-} module SimpleParser.Errata ( LinePosExplainable , errataParseError , errataParseResult ) where import Control.Monad (join) import Data.Foldable (toList) import Data.Sequence (Seq (..)) import qualified Data.Text as T import Errata (Block, PointerStyle, Style, blockMerged') import SimpleParser.Explain (ErrorExplanation (..), Explainable, ParseErrorExplanation (..), TextBuildable, explainParseError) import SimpleParser.Result (ParseError, ParseErrorBundle (ParseErrorBundle), ParseResult (..)) import SimpleParser.Stream (Col (..), HasLinePos (..), Line (..), Pos, Span (..), Stream (Chunk, Token)) type LinePosExplainable l s e = (Explainable l s e, HasLinePos (Pos s), TextBuildable (Token s), TextBuildable (Chunk s)) errataExplanation :: HasLinePos p => Style -> PointerStyle -> FilePath -> ParseErrorExplanation p -> Block errataExplanation :: forall p. HasLinePos p => Style -> PointerStyle -> FilePath -> ParseErrorExplanation p -> Block errataExplanation Style bsty PointerStyle psty FilePath fp (ParseErrorExplanation Span p sp Seq Text context Maybe Text mayDetails (ErrorExplanation Text reason Maybe Text mayExpected Maybe Text mayActual)) = let Span p startPos p endPos = Span p sp startLine :: Int startLine = Line -> Int unLine (forall p. HasLinePos p => p -> Line viewLine p startPos) startCol :: Int startCol = Col -> Int unCol (forall p. HasLinePos p => p -> Col viewCol p startPos) endLine :: Int endLine = Line -> Int unLine (forall p. HasLinePos p => p -> Line viewLine p endPos) endCol :: Int endCol = Col -> Int unCol (forall p. HasLinePos p => p -> Col viewCol p endPos) mayLabel :: Maybe Text mayLabel = forall a. a -> Maybe a Just Text reason mayHeader :: Maybe Text mayHeader = case Seq Text context of Seq Text Empty -> forall a. Maybe a Nothing Seq Text _ -> forall a. a -> Maybe a Just (Text -> [Text] -> Text T.intercalate Text " > " (forall (t :: * -> *) a. Foldable t => t a -> [a] toList Seq Text context)) start :: (Int, Int, Maybe Text) start = (Int startLine forall a. Num a => a -> a -> a + Int 1, Int startCol forall a. Num a => a -> a -> a + Int 1, Maybe Text mayLabel) end :: (Int, Int, Maybe Text) end = (Int endLine forall a. Num a => a -> a -> a + Int 1, Int endCol forall a. Num a => a -> a -> a + Int 1, forall a. Maybe a Nothing) mayBody :: Maybe Text mayBody = case (Maybe Text mayDetails, Maybe Text mayExpected, Maybe Text mayActual) of (Maybe Text Nothing, Maybe Text Nothing, Maybe Text Nothing) -> forall a. Maybe a Nothing (Maybe Text, Maybe Text, Maybe Text) _ -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ [Text] -> Text T.unlines forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. Monad m => m (m a) -> m a join [ forall b a. b -> (a -> b) -> Maybe a -> b maybe [] (\Text de -> [Text "[Details ] " forall a. Semigroup a => a -> a -> a <> Text de]) Maybe Text mayDetails , forall b a. b -> (a -> b) -> Maybe a -> b maybe [] (\Text ex -> [Text "[Expected] " forall a. Semigroup a => a -> a -> a <> Text ex]) Maybe Text mayExpected , forall b a. b -> (a -> b) -> Maybe a -> b maybe [] (\Text ac -> [Text "[Actual ] " forall a. Semigroup a => a -> a -> a <> Text ac]) Maybe Text mayActual ] in Style -> PointerStyle -> FilePath -> Maybe Text -> (Int, Int, Maybe Text) -> (Int, Int, Maybe Text) -> Maybe Text -> Maybe Text -> Block blockMerged' Style bsty PointerStyle psty FilePath fp Maybe Text mayHeader (Int, Int, Maybe Text) start (Int, Int, Maybe Text) end Maybe Text mayLabel Maybe Text mayBody errataParseError :: LinePosExplainable l s e => Style -> PointerStyle -> FilePath -> ParseError l s e -> Block errataParseError :: forall l s e. LinePosExplainable l s e => Style -> PointerStyle -> FilePath -> ParseError l s e -> Block errataParseError Style bsty PointerStyle psty FilePath fp ParseError l s e pe = let pee :: ParseErrorExplanation (Pos s) pee = forall s l e. (TextBuildable (Token s), TextBuildable (Chunk s), Explainable l s e) => ParseError l s e -> ParseErrorExplanation (Pos s) explainParseError ParseError l s e pe in forall p. HasLinePos p => Style -> PointerStyle -> FilePath -> ParseErrorExplanation p -> Block errataExplanation Style bsty PointerStyle psty FilePath fp ParseErrorExplanation (Pos s) pee errataParseResult :: LinePosExplainable l s e => Style -> PointerStyle -> FilePath -> ParseResult l s e a -> [Block] errataParseResult :: forall l s e a. LinePosExplainable l s e => Style -> PointerStyle -> FilePath -> ParseResult l s e a -> [Block] errataParseResult Style bsty PointerStyle psty FilePath fp ParseResult l s e a pr = case ParseResult l s e a pr of ParseResultError (ParseErrorBundle NESeq (ParseError l s e) errs) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall l s e. LinePosExplainable l s e => Style -> PointerStyle -> FilePath -> ParseError l s e -> Block errataParseError Style bsty PointerStyle psty FilePath fp) (forall (t :: * -> *) a. Foldable t => t a -> [a] toList NESeq (ParseError l s e) errs) ParseResultSuccess ParseSuccess s a _ -> []