module ParseLib.Simple.Run where

import Data.List (find)
import Data.Maybe (fromMaybe)
import ParseLib.Error (ErrorsPretty)
import ParseLib.Simple.Core (Parser, parseImproved)

-- | replacement for @Main.run@ in @P3-CSharp@ that uses `parseImproved`,
-- specifies the corresponding type class constraints, and does not parse
-- and print to standard error (stderr) 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]
x =
  (a, [s]) -> a
forall a b. (a, b) -> a
fst ((a, [s]) -> a) -> ([s] -> (a, [s])) -> [s] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, [s])] -> (a, [s])
forall {t :: * -> *} {a} {t :: * -> *} {a}.
(Show (t (a, t a)), Foldable t, Foldable t) =>
t (a, t a) -> (a, t a)
firstFullParseOrError ([(a, [s])] -> (a, [s])) -> ([s] -> [(a, [s])]) -> [s] -> (a, [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser s a -> [s] -> [(a, [s])]
forall s a.
(ErrorsPretty s, Ord s) =>
Parser s a -> [s] -> [(a, [s])]
parseImproved Parser s a
p ([s] -> a) -> [s] -> a
forall a b. (a -> b) -> a -> b
$ [s]
x
  where
    firstFullParseOrError :: t (a, t a) -> (a, t a)
firstFullParseOrError t (a, t a)
l =
      (a, t a) -> Maybe (a, t a) -> (a, t a)
forall a. a -> Maybe a -> a
fromMaybe
        (String -> (a, t a)
forall a. HasCallStack => String -> a
error (String -> (a, t a)) -> String -> (a, t a)
forall a b. (a -> b) -> a -> b
$
          String
"The " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
          String
" returned no full parses. " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
          String
"Here are all parses that didn't consume the entire input:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
          t (a, t a) -> String
forall a. Show a => a -> String
show t (a, t a)
l
        ) (Maybe (a, t a) -> (a, t a)) -> Maybe (a, t a) -> (a, t a)
forall a b. (a -> b) -> a -> b
$
      ((a, t a) -> Bool) -> t (a, t a) -> Maybe (a, t a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (t a -> Bool) -> ((a, t a) -> t a) -> (a, t a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, t a) -> t a
forall a b. (a, b) -> b
snd) (t (a, t a) -> Maybe (a, t a)) -> t (a, t a) -> Maybe (a, t a)
forall a b. (a -> b) -> a -> b
$
      t (a, t a)
l