module ParseLib.Simple.Run where

import Data.List.NonEmpty (NonEmpty ((:|)))
import ParseLib.Error
  ( ErrorsPretty (errorBundlePrettyImproved),
    defaultConfig,
  )
import ParseLib.Simple.Core (Parser, parseWithConfig)
import ParseLib.Simple.Derived (eof)

-- | replacement for @Main.run@ in @P3-CSharp@ that uses `parseImproved`,
-- specifies the corresponding type class constraints, ensures library
-- level error reporting for partial parses, and parses and prints to
-- standard error (stderr) once instead of twice
run :: (ErrorsPretty s, Ord s, Show a) => String -> Parser s a -> [s] -> a
run :: forall s a.
(ErrorsPretty s, Ord s, Show a) =>
String -> Parser s a -> [s] -> a
run String
s Parser s a
p [s]
input =
  case Config
-> Parser s a
-> [s]
-> Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
forall s a.
Ord s =>
Config
-> Parser s a
-> [s]
-> Either (ParseErrorBundle [s]) (NonEmpty (a, [s]))
parseWithConfig Config
defaultConfig (Parser s a
p Parser s a
-> ([s] -> ([((), [s])], DifferenceList (ParseError [s])))
-> Parser s a
forall a b. ([s] -> a) -> ([s] -> b) -> [s] -> a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [s] -> ([((), [s])], DifferenceList (ParseError [s]))
forall s. Parser s ()
eof) [s]
input of
    Right ((a
result, [s]
_) :| [(a, [s])]
_) -> a
result
    Left ParseErrorBundle [s]
errors ->
      String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
        String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" error:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
        Config -> [s] -> ParseErrorBundle [s] -> String
forall symbol.
ErrorsPretty symbol =>
Config -> [symbol] -> ParseErrorBundle [symbol] -> String
errorBundlePrettyImproved Config
defaultConfig [s]
input ParseErrorBundle [s]
errors