{-# LANGUAGE OverloadedStrings #-}

module SimpleParser.Interactive
  ( parseInteractive
  ) where

import Data.Foldable (toList)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import SimpleParser.Explain (Explainable, buildAllParseErrorExplanations, explainParseError)
import SimpleParser.Input (matchEnd)
import SimpleParser.Parser (Parser, runParser)
import SimpleParser.Result (ParseResult (..), ParseSuccess (..))
import SimpleParser.Stream (LinePosStream, newLinePosStream)
import qualified Text.Builder as TB

parseInteractive :: (s ~ LinePosStream Text, Explainable l s e, Show a) => Parser l s e a -> String -> IO ()
parseInteractive :: Parser l s e a -> String -> IO ()
parseInteractive Parser l s e a
parser String
input =
  case Parser l s e a -> s -> Maybe (ParseResult l s e a)
forall l s e a. Parser l s e a -> s -> Maybe (ParseResult l s e a)
runParser (Parser l s e a
parser Parser l s e a -> ParserT l s e Identity () -> Parser l s e a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT l s e Identity ()
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m ()
matchEnd) (Text -> LinePosStream Text
forall s. s -> LinePosStream s
newLinePosStream (String -> Text
T.pack String
input)) of
    Maybe (ParseResult l s e a)
Nothing ->
      String -> IO ()
putStrLn String
"No result."
    Just (ParseResultError NESeq (ParseError l s e)
es) ->
      let b :: Builder
b = [ParseErrorExplanation LinePos] -> Builder
forall (f :: * -> *).
Foldable f =>
f (ParseErrorExplanation LinePos) -> Builder
buildAllParseErrorExplanations ((ParseError l s e -> ParseErrorExplanation LinePos)
-> [ParseError l s e] -> [ParseErrorExplanation LinePos]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseError l s e -> ParseErrorExplanation LinePos
forall l s e.
Explainable l s e =>
ParseError l s e -> ParseErrorExplanation (Pos s)
explainParseError (NESeq (ParseError l s e) -> [ParseError l s e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NESeq (ParseError l s e)
es))
      in Text -> IO ()
TIO.putStrLn (Builder -> Text
TB.run (Builder
"Errors:\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b))
    Just (ParseResultSuccess (ParseSuccess s
_ a
a)) ->
      String -> IO ()
putStrLn String
"Success:" IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> IO ()
forall a. Show a => a -> IO ()
print a
a