Terrible non-deterministic parser combinators that you shouldn't use

parser_nondet.hs

{-# LANGUAGE ParallelListComp #-}

import Data.Char (isDigit)
import Data.List (nub)
import Data.Monoid ((<>))

parse :: Eq a => Parser tk a -> [tk] -> Maybe [a]
parse p tk = case runParser p tk of
  [] -> Nothing
  xs -> Just $ nub $ map snd xs

newtype Parser tk a = Parser { runParser' :: [tk] -> [([tk], a)] }

runParser :: Parser tk a -> [tk] -> [([tk],a)]
runParser ps [] = runParser' ps []
runParser ps tk = runParser' ps tk <> runParser ps (tail tk)

instance Functor (Parser tk) where
  fmap f ps = Parser $ fmap (fmap f) . runParser ps

instance Applicative (Parser tk) where
  pure x    = Parser $ \ tks -> [(tks, x)]
  fs <*> xs = Parser $ \ tks ->
    [ (tks'', fs' xs')
    | (tks',  fs') <- runParser fs tks
    , (tks'', xs') <- runParser xs tks'
    ]

instance Monad (Parser tk) where
  xs >>= fs = Parser $ \ tks ->
    [ (tks'', rs)
    | (tks',  ys) <- runParser xs tks
    , (tks'', rs) <- runParser (fs ys) tks'
    ]

token :: Eq tk => tk -> Parser tk tk
token tk = satisfies (sat (== tk))

sat :: (a -> Bool) -> a -> Maybe a
sat f x | f x = Just x
sat _ _       = Nothing

satisfies :: (tk -> Maybe a) -> Parser tk a
satisfies f = Parser go
  where go (x:xs)
          | Just r <- f x = [(xs, r)]
        go tks            = []

sampleParser :: Parser String String
sampleParser = do
  token "["
  r <- satisfies $ sat $ all isDigit
  token "]"
  return r

r1 :: Maybe [String]
r1 = parse sampleParser $ words "[ 30 ]"

r2 :: Maybe [String]
r2 = parse sampleParser $ words "these [ bits 30 get ] ignored"

r3 :: Maybe [String]
r3 = parse sampleParser $ words "these [ bits 30 50 get ] ignored"