{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}

module KDL.Decoder.Internal.Error (
  DecodeError (..),
  BaseDecodeError,
  DecodeErrorKind (..),
  Context (..),
  ContextItem (..),
  renderDecodeError,
) where

import Control.Exception (Exception (..))
import Data.Default (Default (..))
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text (Text)
import Data.Text qualified as Text
import KDL.Render (
  renderIdentifier,
  renderValue,
 )
import KDL.Types (
  Identifier,
  Span (..),
  Value,
 )
import System.FilePath (takeFileName)
import Prelude hiding (span)

data DecodeError = DecodeError
  { DecodeError -> Maybe FilePath
filepath :: Maybe FilePath
  , DecodeError -> NonEmpty (Context, DecodeErrorKind)
errors :: NonEmpty BaseDecodeError
  }
  deriving (Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> FilePath
(Int -> DecodeError -> ShowS)
-> (DecodeError -> FilePath)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeError -> ShowS
showsPrec :: Int -> DecodeError -> ShowS
$cshow :: DecodeError -> FilePath
show :: DecodeError -> FilePath
$cshowList :: [DecodeError] -> ShowS
showList :: [DecodeError] -> ShowS
Show, DecodeError -> DecodeError -> Bool
(DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> Bool) -> Eq DecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeError -> DecodeError -> Bool
== :: DecodeError -> DecodeError -> Bool
$c/= :: DecodeError -> DecodeError -> Bool
/= :: DecodeError -> DecodeError -> Bool
Eq)

instance Exception DecodeError where
  displayException :: DecodeError -> FilePath
displayException = Text -> FilePath
Text.unpack (Text -> FilePath)
-> (DecodeError -> Text) -> DecodeError -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeError -> Text
renderDecodeError

type BaseDecodeError = (Context, DecodeErrorKind)

data Context = Context
  { Context -> [ContextItem]
path :: [ContextItem]
  , Context -> Maybe Span
span :: Maybe Span
  , Context -> Maybe Text
srcLine :: Maybe Text
  }
  deriving (Int -> Context -> ShowS
[Context] -> ShowS
Context -> FilePath
(Int -> Context -> ShowS)
-> (Context -> FilePath) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Context -> ShowS
showsPrec :: Int -> Context -> ShowS
$cshow :: Context -> FilePath
show :: Context -> FilePath
$cshowList :: [Context] -> ShowS
showList :: [Context] -> ShowS
Show, Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
/= :: Context -> Context -> Bool
Eq)

instance Default Context where
  def :: Context
def =
    Context
      { path :: [ContextItem]
path = []
      , span :: Maybe Span
span = Maybe Span
forall a. Maybe a
Nothing
      , srcLine :: Maybe Text
srcLine = Maybe Text
forall a. Maybe a
Nothing
      }

data ContextItem
  = ContextNode
      { ContextItem -> Identifier
name :: Identifier
      , ContextItem -> Int
index :: Int
      }
  | ContextArg
      { index :: Int
      , ContextItem -> Maybe Text
label :: Maybe Text
      }
  | ContextProp
      { name :: Identifier
      }
  deriving (Int -> ContextItem -> ShowS
[ContextItem] -> ShowS
ContextItem -> FilePath
(Int -> ContextItem -> ShowS)
-> (ContextItem -> FilePath)
-> ([ContextItem] -> ShowS)
-> Show ContextItem
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContextItem -> ShowS
showsPrec :: Int -> ContextItem -> ShowS
$cshow :: ContextItem -> FilePath
show :: ContextItem -> FilePath
$cshowList :: [ContextItem] -> ShowS
showList :: [ContextItem] -> ShowS
Show, ContextItem -> ContextItem -> Bool
(ContextItem -> ContextItem -> Bool)
-> (ContextItem -> ContextItem -> Bool) -> Eq ContextItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContextItem -> ContextItem -> Bool
== :: ContextItem -> ContextItem -> Bool
$c/= :: ContextItem -> ContextItem -> Bool
/= :: ContextItem -> ContextItem -> Bool
Eq, Eq ContextItem
Eq ContextItem =>
(ContextItem -> ContextItem -> Ordering)
-> (ContextItem -> ContextItem -> Bool)
-> (ContextItem -> ContextItem -> Bool)
-> (ContextItem -> ContextItem -> Bool)
-> (ContextItem -> ContextItem -> Bool)
-> (ContextItem -> ContextItem -> ContextItem)
-> (ContextItem -> ContextItem -> ContextItem)
-> Ord ContextItem
ContextItem -> ContextItem -> Bool
ContextItem -> ContextItem -> Ordering
ContextItem -> ContextItem -> ContextItem
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ContextItem -> ContextItem -> Ordering
compare :: ContextItem -> ContextItem -> Ordering
$c< :: ContextItem -> ContextItem -> Bool
< :: ContextItem -> ContextItem -> Bool
$c<= :: ContextItem -> ContextItem -> Bool
<= :: ContextItem -> ContextItem -> Bool
$c> :: ContextItem -> ContextItem -> Bool
> :: ContextItem -> ContextItem -> Bool
$c>= :: ContextItem -> ContextItem -> Bool
>= :: ContextItem -> ContextItem -> Bool
$cmax :: ContextItem -> ContextItem -> ContextItem
max :: ContextItem -> ContextItem -> ContextItem
$cmin :: ContextItem -> ContextItem -> ContextItem
min :: ContextItem -> ContextItem -> ContextItem
Ord)

data DecodeErrorKind
  = DecodeError_Custom Text
  | DecodeError_ParseError Text
  | DecodeError_ExpectedNode {DecodeErrorKind -> Text
name :: Text, DecodeErrorKind -> Int
index :: Int}
  | DecodeError_ExpectedArg {index :: Int, DecodeErrorKind -> Maybe Text
label :: Maybe Text, DecodeErrorKind -> [Text]
expectedTypes :: [Text]}
  | DecodeError_ExpectedProp {name :: Text, expectedTypes :: [Text]}
  | DecodeError_MismatchedAnn {DecodeErrorKind -> Identifier
givenAnn :: Identifier, DecodeErrorKind -> [Text]
validAnns :: [Text]}
  | DecodeError_ValueDecodeFail {DecodeErrorKind -> Text
expectedType :: Text, DecodeErrorKind -> Value
value :: Value}
  | DecodeError_UnexpectedNode {DecodeErrorKind -> Identifier
identifier :: Identifier, index :: Int}
  | DecodeError_UnexpectedArg {index :: Int, value :: Value}
  | DecodeError_UnexpectedProp {identifier :: Identifier, value :: Value}
  deriving (Int -> DecodeErrorKind -> ShowS
[DecodeErrorKind] -> ShowS
DecodeErrorKind -> FilePath
(Int -> DecodeErrorKind -> ShowS)
-> (DecodeErrorKind -> FilePath)
-> ([DecodeErrorKind] -> ShowS)
-> Show DecodeErrorKind
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeErrorKind -> ShowS
showsPrec :: Int -> DecodeErrorKind -> ShowS
$cshow :: DecodeErrorKind -> FilePath
show :: DecodeErrorKind -> FilePath
$cshowList :: [DecodeErrorKind] -> ShowS
showList :: [DecodeErrorKind] -> ShowS
Show, DecodeErrorKind -> DecodeErrorKind -> Bool
(DecodeErrorKind -> DecodeErrorKind -> Bool)
-> (DecodeErrorKind -> DecodeErrorKind -> Bool)
-> Eq DecodeErrorKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeErrorKind -> DecodeErrorKind -> Bool
== :: DecodeErrorKind -> DecodeErrorKind -> Bool
$c/= :: DecodeErrorKind -> DecodeErrorKind -> Bool
/= :: DecodeErrorKind -> DecodeErrorKind -> Bool
Eq)

renderDecodeError :: DecodeError -> Text
renderDecodeError :: DecodeError -> Text
renderDecodeError DecodeError
decodeError =
  Text -> [Text] -> Text
Text.intercalate Text
"\n"
    ([Text] -> Text)
-> (NonEmpty (Context, DecodeErrorKind) -> [Text])
-> NonEmpty (Context, DecodeErrorKind)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Context, DecodeErrorKind) -> [Text])
-> NonEmpty (NonEmpty (Context, DecodeErrorKind)) -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (Context, DecodeErrorKind) -> [Text]
renderCtxErrors
    (NonEmpty (NonEmpty (Context, DecodeErrorKind)) -> [Text])
-> (NonEmpty (Context, DecodeErrorKind)
    -> NonEmpty (NonEmpty (Context, DecodeErrorKind)))
-> NonEmpty (Context, DecodeErrorKind)
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Context, DecodeErrorKind) -> Either [ContextItem] Span)
-> NonEmpty (Context, DecodeErrorKind)
-> NonEmpty (NonEmpty (Context, DecodeErrorKind))
forall b a.
Ord b =>
(a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)
NonEmpty.groupAllWith1 (Context, DecodeErrorKind) -> Either [ContextItem] Span
forall {r} {b} {a} {b}.
(HasField "span" r (Maybe b), HasField "path" r a) =>
(r, b) -> Either a b
groupKey
    (NonEmpty (Context, DecodeErrorKind) -> Text)
-> NonEmpty (Context, DecodeErrorKind) -> Text
forall a b. (a -> b) -> a -> b
$ DecodeError
decodeError.errors
 where
  -- Group errors with the same contexts together
  groupKey :: (r, b) -> Either a b
groupKey (r
ctx, b
_) = Either a b -> (b -> Either a b) -> Maybe b -> Either a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a b
forall a b. a -> Either a b
Left r
ctx.path) b -> Either a b
forall a b. b -> Either a b
Right r
ctx.span

  renderCtxErrors :: NonEmpty (Context, DecodeErrorKind) -> [Text]
renderCtxErrors = \case
    -- Special case parse errors, which shouldn't have a context
    (Context
_, DecodeError_ParseError Text
msg) NonEmpty.:| [(Context, DecodeErrorKind)]
_ -> [Text
msg]
    NonEmpty (Context, DecodeErrorKind)
errs ->
      let (Context
ctx, DecodeErrorKind
_) = NonEmpty (Context, DecodeErrorKind) -> (Context, DecodeErrorKind)
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (Context, DecodeErrorKind)
errs
       in Context -> [Text] -> [Text]
renderCtx Context
ctx ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (((Context, DecodeErrorKind) -> Text)
-> [(Context, DecodeErrorKind)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DecodeErrorKind -> Text
renderError (DecodeErrorKind -> Text)
-> ((Context, DecodeErrorKind) -> DecodeErrorKind)
-> (Context, DecodeErrorKind)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context, DecodeErrorKind) -> DecodeErrorKind
forall a b. (a, b) -> b
snd) ([(Context, DecodeErrorKind)] -> [Text])
-> [(Context, DecodeErrorKind)] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Context, DecodeErrorKind) -> [(Context, DecodeErrorKind)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Context, DecodeErrorKind)
errs)

  renderCtx :: Context -> [Text] -> [Text]
renderCtx (Context
ctx :: Context) =
    case Context
ctx.span of
      Maybe Span
Nothing -> [ContextItem] -> [Text] -> [Text]
renderCtxPath Context
ctx.path
      Just Span
span -> Span -> Context -> [Text] -> [Text]
forall {p}.
HasField "srcLine" p (Maybe Text) =>
Span -> p -> [Text] -> [Text]
renderCtxFull Span
span Context
ctx

  -- If we don't have the error span, the best we can do is render the context path:
  --
  -- At: foo.kdl > user #0 > arg #0
  -- ├─ error message
  -- └─ another error message
  renderCtxPath :: [ContextItem] -> [Text] -> [Text]
renderCtxPath [ContextItem]
path [Text]
errors =
    let pathDisplay :: Text
pathDisplay =
          Text -> [Text] -> Text
Text.intercalate Text
" > " ([Text] -> Text) -> ([[Text]] -> [Text]) -> [[Text]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> Text) -> [[Text]] -> Text
forall a b. (a -> b) -> a -> b
$
            [ case DecodeError
decodeError.filepath of
                Maybe FilePath
Nothing -> []
                Just FilePath
fp -> [FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName FilePath
fp]
            , if [ContextItem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ContextItem]
path then [Text
"(root)"] else (ContextItem -> Text) -> [ContextItem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ContextItem -> Text
renderCtxPathItem [ContextItem]
path
            ]
        errors' :: [Text]
errors' =
          [ (if Bool
isLast then Text
"└─ " else Text
"├─ ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
          | (Text
err, Bool
isLast) <- [Text] -> [(Text, Bool)]
forall {a}. [a] -> [(a, Bool)]
withIsLast [Text]
errors
          ]
     in (Text
"At: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pathDisplay) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
errors'
  renderCtxPathItem :: ContextItem -> Text
renderCtxPathItem = \case
    ContextNode{Int
Identifier
name :: ContextItem -> Identifier
index :: ContextItem -> Int
name :: Identifier
index :: Int
..} -> Identifier -> Text
renderIdentifier Identifier
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
index
    ContextArg{Int
Maybe Text
index :: ContextItem -> Int
label :: ContextItem -> Maybe Text
index :: Int
label :: Maybe Text
..} -> Int -> Maybe Text -> Text
forall {a}. Show a => a -> Maybe Text -> Text
renderArg Int
index Maybe Text
label
    ContextProp{Identifier
name :: ContextItem -> Identifier
name :: Identifier
..} -> Text
"prop " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Identifier -> Text
renderIdentifier Identifier
name

  -- If we have the error span, show a descriptive error message:
  --
  -- foo.kdl:3:16:
  --     • Expected number, got string
  --   |
  -- 3 |     some_child bad-value
  --   |                ^^^^^^^^^
  renderCtxFull :: Span -> p -> [Text] -> [Text]
renderCtxFull (Span
span :: Span) p
ctx [Text]
errors =
    let spanDisplay :: Text
spanDisplay =
          [Text] -> Text
Text.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":") ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
            [ Text -> (FilePath -> Text) -> Maybe FilePath -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<input>" FilePath -> Text
Text.pack DecodeError
decodeError.filepath
            , Int -> Text
forall a. Show a => a -> Text
showT Span
span.startLine
            , Int -> Text
forall a. Show a => a -> Text
showT Span
span.startCol
            ]
        errors' :: [Text]
errors' = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"    • " <>) [Text]
errors
        preview :: [Text]
preview =
          case p
ctx.srcLine of
            Maybe Text
Nothing -> []
            Just Text
line ->
              let lineNum :: Text
lineNum = Int -> Text
forall a. Show a => a -> Text
showT Span
span.startLine
                  spaces :: Int -> Text
spaces Int
n = Int -> Text -> Text
Text.replicate Int
n Text
" "
                  renderPrefix :: Bool -> Text
renderPrefix Bool
isSpace = (if Bool
isSpace then Int -> Text
spaces (Text -> Int
Text.length Text
lineNum) else Text
lineNum) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" │"
                  spanLength :: Int
spanLength =
                    if Span
span.startLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Span
span.endLine
                      then Span
span.endCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Span
span.startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      else Text -> Int
Text.length Text
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Span
span.startCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
               in [ Bool -> Text
renderPrefix Bool
True
                  , Bool -> Text
renderPrefix Bool
False Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line
                  , Bool -> Text
renderPrefix Bool
True Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
spaces Span
span.startCol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
spanLength Text
"^"
                  ]
     in Text
spanDisplay Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
errors' [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
preview

  renderError :: DecodeErrorKind -> Text
renderError = \case
    DecodeError_Custom Text
msg -> Text
msg
    DecodeError_ParseError Text
msg -> Text
msg
    DecodeError_ExpectedNode{Int
Text
name :: DecodeErrorKind -> Text
index :: DecodeErrorKind -> Int
name :: Text
index :: Int
..}
      | Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Text
"Expected node: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
      | Bool
otherwise -> Text
"Expected another node: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
    DecodeError_ExpectedArg{Int
[Text]
Maybe Text
index :: DecodeErrorKind -> Int
label :: DecodeErrorKind -> Maybe Text
expectedTypes :: DecodeErrorKind -> [Text]
index :: Int
label :: Maybe Text
expectedTypes :: [Text]
..} ->
      [Text] -> Text
Text.concat
        [ Text
"Expected "
        , Int -> Maybe Text -> Text
forall {a}. Show a => a -> Maybe Text -> Text
renderArg Int
index Maybe Text
label
        , if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
expectedTypes
            then Text
""
            else Text
" with type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
oxfordList Text
"or" [Text]
expectedTypes
        ]
    DecodeError_ExpectedProp{[Text]
Text
name :: DecodeErrorKind -> Text
expectedTypes :: DecodeErrorKind -> [Text]
name :: Text
expectedTypes :: [Text]
..} ->
      [Text] -> Text
Text.concat
        [ Text
"Expected prop '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
        , if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
expectedTypes
            then Text
""
            else Text
" with type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
oxfordList Text
"or" [Text]
expectedTypes
        ]
    DecodeError_MismatchedAnn{[Text]
Identifier
givenAnn :: DecodeErrorKind -> Identifier
validAnns :: DecodeErrorKind -> [Text]
givenAnn :: Identifier
validAnns :: [Text]
..} -> Text
"Expected annotation to be one of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Show a => a -> Text
showT [Text]
validAnns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Identifier -> Text
renderIdentifier Identifier
givenAnn
    DecodeError_ValueDecodeFail{Text
Value
expectedType :: DecodeErrorKind -> Text
value :: DecodeErrorKind -> Value
expectedType :: Text
value :: Value
..} -> Text
"Expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expectedType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
renderValue Value
value
    DecodeError_UnexpectedNode{Int
Identifier
index :: DecodeErrorKind -> Int
identifier :: DecodeErrorKind -> Identifier
identifier :: Identifier
index :: Int
..} -> Text
"Unexpected node: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Identifier -> Text
renderIdentifier Identifier
identifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
index
    DecodeError_UnexpectedArg{Int
Value
index :: DecodeErrorKind -> Int
value :: DecodeErrorKind -> Value
index :: Int
value :: Value
..} -> Text
"Unexpected arg #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showT Int
index Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
renderValue Value
value
    DecodeError_UnexpectedProp{Identifier
Value
value :: DecodeErrorKind -> Value
identifier :: DecodeErrorKind -> Identifier
identifier :: Identifier
value :: Value
..} -> Text
"Unexpected prop: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Identifier -> Text
renderIdentifier Identifier
identifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
renderValue Value
value

  renderArg :: a -> Maybe Text -> Text
renderArg a
index Maybe Text
label = Text
"arg " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
showT a
index) (\Text
s -> Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'") Maybe Text
label

  oxfordList :: Text -> [Text] -> Text
oxfordList Text
conj = \case
    [Text
x] -> Text
x
    [Text
x, Text
y] -> [Text] -> Text
Text.unwords [Text
x, Text
conj, Text
y]
    [Text]
xs -> Text -> [Text] -> Text
Text.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall {a}. (a -> a) -> [a] -> [a]
mapLast ((Text
conj Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") <>) [Text]
xs

  mapLast :: (a -> a) -> [a] -> [a]
mapLast a -> a
f = \case
    [] -> []
    [a
x] -> [a -> a
f a
x]
    a
x : [a]
xs -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
mapLast a -> a
f [a]
xs

  withIsLast :: [a] -> [(a, Bool)]
withIsLast = ((a, Bool) -> (a, Bool)) -> [(a, Bool)] -> [(a, Bool)]
forall {a}. (a -> a) -> [a] -> [a]
mapLast (Bool
True <$) ([(a, Bool)] -> [(a, Bool)])
-> ([a] -> [(a, Bool)]) -> [a] -> [(a, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, Bool)) -> [a] -> [(a, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x, Bool
False))

  -- Replace with Text.show after requiring at least text-2.1.2
  showT :: (Show a) => a -> Text
  showT :: forall a. Show a => a -> Text
showT = FilePath -> Text
Text.pack (FilePath -> Text) -> (a -> FilePath) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
forall a. Show a => a -> FilePath
show