shapr.hs

type Message = ([String],String)

parse :: Monad m
  => AB.Parser a
  -> Stream (Of ByteString) m r
  -> m (Either a Message, Stream (Of ByteString) m r)
parse parser bs = do
  (e,rest) <- apply parser bs
  pure (either Right Left e, rest)

apply :: Monad m
  => AB.Parser a
  -> Stream (Of ByteString) m r
  -> m (Either Message a, Stream (Of ByteString) m r)
apply parser = begin where
  begin = \case
    Effect m -> m >>= begin
    Return r -> step id (AB.parse parser mempty) (pure r)
    Step (bs :> rest) -> if B.null bs -- attoparsec understands "" as eof.
      then begin rest
      else step (S.yield bs >>) (AB.parse parser bs) rest

  step diff res p0 = case res of
    AB.Fail _ c m -> pure (Left (c,m), diff p0)
    AB.Done a b   -> pure (Right b, S.yield a >> p0)
    AB.Partial k  -> do
      let clean = \case -- inspect for null chunks before
            Effect m -> m >>= clean -- feeding attoparsec
            Return r -> step diff (k mempty) (pure r)
            Step (bs :> rest) -> if B.null bs
              then clean rest
              else step (diff . (S.yield bs >>)) (k bs) rest
      clean p0