{-# 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, ParseResult (..)) import SimpleParser.Stream (Col (..), Line (..), LinePos (..), Pos, Span (..)) type LinePosExplainable l s e = (Explainable l s e, Pos s ~ LinePos) errataExplanation :: Style -> FilePath -> ParseErrorExplanation LinePos -> Block errataExplanation :: Style -> FilePath -> ParseErrorExplanation LinePos -> Block errataExplanation Style style FilePath fp (ParseErrorExplanation Span LinePos sp Seq Text context Maybe Text mayDetails (ErrorExplanation Text reason Maybe Text mayExpected Maybe Text mayActual)) = let Span (LinePos Offset _ (Line Int startLine) (Col Int startCol)) (LinePos Offset _ (Line Int endLine) (Col Int endCol)) = Span LinePos sp 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 LinePos -> Block errataExplanation Style style FilePath fp ParseErrorExplanation LinePos 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 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 _ -> []