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