content: {-# OPTIONS_GHC -Wno-orphans #-}
  
  module Control.Monad.Yoctoparsec.Class where
  
  import Control.Applicative (Alternative (empty))
  import Control.Monad (MonadPlus, foldM, mfilter)
  import Control.Monad.Trans.Free (FreeF (..), FreeT (..))
  import qualified Control.Monad.Yoctoparsec as Yocto
  import Data.Foldable (Foldable (..))
  import Text.Parser.Char (CharParsing (..))
  import Text.Parser.Combinators (Parsing (..))
  import Text.Parser.Token (TokenParsing)
  
  instance (MonadPlus b, MonadFail b) => Parsing (FreeT ((->) i) b) where
    try = id
    (<?>) = const
    unexpected = fail
    eof = pure ()
    notFollowedBy _ = pure ()
  
  instance (MonadPlus b, MonadFail b) => CharParsing (FreeT ((->) Char) b) where
    satisfy p = mfilter p Yocto.token
  
  instance (MonadPlus b, MonadFail b) => TokenParsing (FreeT ((->) Char) b)
  
  data Result b i a = Partial (i -> b (Result b i a)) | Done a [i]
  
  instance (Show a, Show i) => Show (Result b i a) where
    show (Partial _) = "Partial"
    show (Done a is) = "Done (" <> show a <> ") (" <> show is <> ")"
  
  runParser :: forall b i a. (Monad b, Foldable b) => Yocto.Parser b i a -> b (Result b i a)
  runParser p = do
    val <- runFreeT p
    pure $ case val of
      Pure a -> Done a []
      Free f -> Partial (runParser . f)
  
  feed1 :: forall b i a. Applicative b => Result b i a -> i -> b (Result b i a)
  feed1 (Partial f) i = f i
  feed1 (Done a is) i = pure $ Done a (is <> [i])
  
  feed :: forall t b i a. (Foldable t, Monad b) => Result b i a -> t i -> b (Result b i a)
  feed = foldM feed1
  
  feedOnly :: forall t b i a. (Foldable t, Monad b, Alternative b) => Result b i a -> t i -> b (Result b i a)
  feedOnly r t =
    go r (toList t)
    where
      go (Partial _) [] = empty
      go (Done a is) [] = pure $ Done a is
      go r' (i : is) = do
        r'' <- feed1 r' i
        go r'' is
  