{-# 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
_ -> []