Regex-style lazy parsers

lazy-parsers.hs

{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, PatternSynonyms, RankNTypes #-}

import Control.Applicative
import Control.Monad.Codensity
import Control.Monad.Trans
import Text.Parser.Combinators
import Text.Parser.Char

import qualified Data.Attoparsec.ByteString.Char8 as AP

-- Lazy r p behaves like p except it only succeeds if the parse succeeds
-- and the successor parse also succeeds. The successor can be provided with
-- the ?>>= or ?>> functions.

-- This allows you to write: many anyChar ?>> string "foo", much like you can write
-- .*?foo in regex.
newtype Lazy p a = Lazy (Codensity p a)
  deriving (Functor, Applicative, Monad, MonadTrans)

pattern LazyF f = Lazy (Codensity f)

mapLazy :: (forall r. p r -> p r) -> Lazy p a -> Lazy p a
mapLazy f (LazyF g) = LazyF (f . g)

instance Alternative p => Alternative (Lazy p) where
  empty = LazyF $ \_ -> empty
  LazyF p <|> LazyF p' = LazyF $ \cc -> p cc <|> p' cc
  many p = pure [] <|> some p

instance (Parsing p, Monad p) => Parsing (Lazy p) where
  try = mapLazy try
  p <?> n = mapLazy (<?> n) p
  unexpected s = LazyF $ \_ -> unexpected s
  notFollowedBy p = (p >>= unexpected . show) <|> pure ()

instance (CharParsing p, Monad p) => CharParsing (Lazy p)

(?>>=) :: Lazy p a -> (a -> p b) -> p b
Lazy c ?>>= f = runCodensity c f

(?>>) :: Lazy p a -> p b -> p b
p ?>> m = p ?>>= const m

infixr 1 ?>>=, ?>>

testEager :: AP.Parser ()
testEager = many anyChar *> string "foo" *> pure ()

testLazy :: AP.Parser()
testLazy = many anyChar ?>> string "foo" *> pure ()

testEager2 :: AP.Parser String
testEager2 = do
  foo <- some anyChar
  string foo

testLazy2 :: AP.Parser String
testLazy2 =
  some anyChar ?>>= \foo ->
    string foo

main = do
  let str = "barbazfoo"
  print $ AP.parseOnly testEager str -- fails
  print $ AP.parseOnly testLazy str -- succeeds

  let str2 = "abbaabbaabba"
  print $ AP.parseOnly testEager2 str2 -- fails
  print $ AP.parseOnly testLazy2 str2 -- succeeds