{-# LANGUAGE OverloadedStrings #-} -- for easy error building

-- | Common parser error definitions.

module Binrep.Get.Error where

import Data.Text.Builder.Linear qualified as TBL
import Data.Text qualified as Text
import Numeric.Natural ( Natural )

-- | Top-level parse error.
--
-- The final element is the concrete error. Prior elements should "contain" the
-- error (i.e. be the larger part that the error occurred in).
--
-- Really should be non-empty-- but by using List, we can use the empty list for
-- Fail. Bit of a cute cheat.
type ParseError pos text = [ParseErrorSingle pos text]

-- | A single indexed parse error.
data ParseErrorSingle pos text = ParseErrorSingle
  { forall pos text. ParseErrorSingle pos text -> pos
parseErrorSinglePos  :: pos
  , forall pos text. ParseErrorSingle pos text -> [text]
parseErrorSingleText :: [text]
  } deriving stock Int -> ParseErrorSingle pos text -> ShowS
[ParseErrorSingle pos text] -> ShowS
ParseErrorSingle pos text -> String
(Int -> ParseErrorSingle pos text -> ShowS)
-> (ParseErrorSingle pos text -> String)
-> ([ParseErrorSingle pos text] -> ShowS)
-> Show (ParseErrorSingle pos text)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall pos text.
(Show pos, Show text) =>
Int -> ParseErrorSingle pos text -> ShowS
forall pos text.
(Show pos, Show text) =>
[ParseErrorSingle pos text] -> ShowS
forall pos text.
(Show pos, Show text) =>
ParseErrorSingle pos text -> String
$cshowsPrec :: forall pos text.
(Show pos, Show text) =>
Int -> ParseErrorSingle pos text -> ShowS
showsPrec :: Int -> ParseErrorSingle pos text -> ShowS
$cshow :: forall pos text.
(Show pos, Show text) =>
ParseErrorSingle pos text -> String
show :: ParseErrorSingle pos text -> String
$cshowList :: forall pos text.
(Show pos, Show text) =>
[ParseErrorSingle pos text] -> ShowS
showList :: [ParseErrorSingle pos text] -> ShowS
Show

-- | Map over the @pos@ index type of a 'ParseErrorSingle'.
mapParseErrorSinglePos
    :: (pos1 -> pos2)
    -> ParseErrorSingle pos1 text
    -> ParseErrorSingle pos2 text
mapParseErrorSinglePos :: forall pos1 pos2 text.
(pos1 -> pos2)
-> ParseErrorSingle pos1 text -> ParseErrorSingle pos2 text
mapParseErrorSinglePos pos1 -> pos2
f (ParseErrorSingle pos1
pos [text]
text) =
    pos2 -> [text] -> ParseErrorSingle pos2 text
forall pos text. pos -> [text] -> ParseErrorSingle pos text
ParseErrorSingle (pos1 -> pos2
f pos1
pos) [text]
text

-- | Shorthand for one parse error.
parseError1 :: [text] -> pos -> ParseError pos text
parseError1 :: forall text pos. [text] -> pos -> ParseError pos text
parseError1 [text]
texts pos
pos = [pos -> [text] -> ParseErrorSingle pos text
forall pos text. pos -> [text] -> ParseErrorSingle pos text
ParseErrorSingle pos
pos [text]
texts]

-- | Construct a parse error message for a generic field failure.
parseErrorTextGenericFieldBld
    :: String -> String -> Maybe String -> Natural
    -> [TBL.Builder]
parseErrorTextGenericFieldBld :: String -> String -> Maybe String -> Natural -> [Builder]
parseErrorTextGenericFieldBld String
dtName String
cstrName (Just String
fieldName) Natural
_fieldIdx =
  [    Builder
"in " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TBL.fromText (String -> Text
Text.pack String
dtName)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>   Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TBL.fromText (String -> Text
Text.pack String
cstrName)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>   Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TBL.fromText (String -> Text
Text.pack String
fieldName) ]
parseErrorTextGenericFieldBld String
dtName String
cstrName Maybe String
Nothing           Natural
fieldIdx =
  [    Builder
"in " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TBL.fromText (String -> Text
Text.pack String
dtName)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>   Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TBL.fromText (String -> Text
Text.pack String
cstrName)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>   Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Natural -> Builder
forall a. Integral a => a -> Builder
TBL.fromUnboundedDec Natural
fieldIdx ]

-- | Construct a parse error message for a generic sum tag no-match.
parseErrorTextGenericNoCstrMatchBld :: String -> [TBL.Builder]
parseErrorTextGenericNoCstrMatchBld :: String -> [Builder]
parseErrorTextGenericNoCstrMatchBld String
dtName =
  [    Builder
"sum tag did not match any constructors in "
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TBL.fromText (String -> Text
Text.pack String
dtName) ]

-- | Construct a parse error message for a generic sum tag parse error.
parseErrorTextGenericSumTagBld :: String -> [TBL.Builder]
parseErrorTextGenericSumTagBld :: String -> [Builder]
parseErrorTextGenericSumTagBld String
dtName =
  [    Builder
"while parsing sum tag in " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TBL.fromText (String -> Text
Text.pack String
dtName) ]