Error.hs

module Core.Text.Megaparsec.Error
  ( traverseErrorSource
  , mapErrorSourceStream
  , mapErrorSource
  ) where

import Text.Megaparsec.Error
import qualified Data.Set as Set
import qualified Core.Data.Set as Set
import Data.Maybe
import Core.Data.List
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty

-- | By converting each individual source token into a collection of
-- source tokens, converts each individual "unexpected token" error into
-- a collection of "unexpected" token errors.
-- Mainly used to convert errors parsing larger groups of items errors
-- parsing smaller groups of items.
traverseErrorSource :: (Ord t2) => (t1 -> [t2]) -> ParseError t1 e -> ParseError t2 e
traverseErrorSource f (TrivialError poss actual expecteds)
  = TrivialError poss actual' expecteds'
  where actual' = maybeHead =<< traverseErrorItemSource f <$> actual
        expecteds' = Set.concatMap (traverseErrorItemSource f) expecteds
traverseErrorSource _ (FancyError poss fancy) = FancyError poss fancy

mapErrorSourceStream :: (Ord t2) => (NonEmpty t1 -> NonEmpty t2) -> ParseError t1 e -> ParseError t2 e
mapErrorSourceStream f (TrivialError poss actual expecteds)
  = TrivialError poss actual' expecteds'
  where actual' = mapErrorItemSourceStream f <$> actual
        expecteds' = Set.map (mapErrorItemSourceStream f) expecteds
mapErrorSourceStream _ (FancyError poss fancy) = FancyError poss fancy

mapErrorSource :: (Ord t2) => (t1 -> t2) -> ParseError t1 e -> ParseError t2 e
mapErrorSource f (TrivialError poss actual expecteds)
  = TrivialError poss (fmap f <$> actual) (Set.map (fmap f) expecteds)
mapErrorSource _ (FancyError poss fancy) = FancyError poss fancy

traverseErrorItemSource :: (Ord t2) => (t1 -> [t2]) -> ErrorItem t1 -> [ErrorItem t2]
traverseErrorItemSource f (Tokens tokens)
  = Tokens <$> mapMaybe (NonEmpty.nonEmpty . f) (NonEmpty.toList tokens)
traverseErrorItemSource _ (Label label) = [Label label]
traverseErrorItemSource _ EndOfInput = [EndOfInput]

mapErrorItemSourceStream :: (Ord t2) => (NonEmpty t1 -> NonEmpty t2) -> ErrorItem t1 -> ErrorItem t2
mapErrorItemSourceStream f (Tokens tokens) = Tokens $ f tokens
mapErrorItemSourceStream _ (Label label) = Label label
mapErrorItemSourceStream _ EndOfInput = EndOfInput