Simple example of wildcard expressions in Haskell

wildcard-parsers-simple.hs

module Main where

  data Result a = Success String a | Error deriving Show
  data Parser a = Parser { parse :: String -> Result a }

  --a parser that always succeeds with the provided value
  success :: a -> Parser a
  success a = Parser (\as -> Success as a)

  --a parser that always fails
  failure :: Parser a
  failure = Parser (const Error)

  isError :: Result a -> Bool
  isError Error         = True
  isError (Success _ _) = False

  --transforms value within a parser (functor's fmap)
  pmap :: (a -> b) -> Parser a -> Parser b
  pmap f p = p ~> (success . f)

  --combines two parsers together into one (monadic 'bind')
  (~>) :: Parser a -> (a -> Parser b) -> Parser b
  p ~> f = Parser (\as -> case parse p as of
                          Success as' a'  -> parse (f a') as'
                          Error  -> Error)

  --uses the first parser, if it fails uses the second one
  orElse :: Parser a -> Parser a -> Parser a
  p1 `orElse` p2 =
    Parser (\as -> let res = parse p1 as
                   in if isError res then parse p2 as else res)

  --parses one char
  char :: Parser Char
  char = Parser (\inp -> case inp of
    []     -> Error
    (a:as) -> Success as a)

  --parses a char that satisfies the predicate
  takeIf :: (Char -> Bool) -> Parser Char
  takeIf f = char ~> (\c -> if f c then success c else failure)

  oneOrMany :: Parser a -> Parser [a]
  oneOrMany p = p ~> (\a -> zeroOrMany p ~> (\as -> success (a : as)))

  zeroOrMany :: Parser a -> Parser [a]
  zeroOrMany p = oneOrMany p `orElse` success []

  is :: Char -> Parser Char
  is a = takeIf (== a)

  toString :: Parser Char -> Parser String
  toString = pmap (\a -> [a])

  -- I use the same parsers combinators for both evaluating the expression
  -- and parsing the expression itself :)
  expr :: String -> Parser String
  expr str = p ~> compose p1
    where
      (p, p1) = foldl collapse (empty, empty) str
      empty = success ""
      compose p a = (a ++) `pmap` p
      collapse (p, p1) ch = case ch of
        '.' -> (p ~> compose p1, toString char)
        '*' -> (p, pmap concat (zeroOrMany p1))
        chr -> (p ~> compose p1, toString $ is ch)

  main :: IO ()
  main = print $ parse (expr "h.*") "hello world"