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