{-# LANGUAGE GADTs #-}

-- | Removing the constructor for (>>=).
module Parser2
  ( P           -- :: * -> * -> *
  , symbol      -- :: P s s
  , pfail       -- :: P s a
  , (+++)       -- :: P s a -> P s a -> P s a
  , ParseResult -- ParseResult s a = [(a, [s])]
  , parse       -- :: P s a -> [s] -> ParseResult s a
  ) where

type ParseResult s a = [(a, [s])]

{-| The first problem we identified was the list comprehension. The
    problem would go away if we could get rid of the constructor for
    (>>=). (We linearize the sequencing operation). To do this, let's
    look at what laws we have pertaining to (>>=):

      L1.  return x  >>= f  ==  f x
      L3.  (p >>= f) >>= g  ==  p >>= (\x -> f x >>= g)
      L4.  fail      >>= f  ==  fail
      L5.  (p +++ q) >>= f  ==  (p >>= f) +++ (q >>= f)

    We can simplify uses of (>>=) for all possible values of the first argument
    except 'symbol'. So what we do is to introduce a specialised constructor for this
    case and get rid of the general (:>>=).

      SymbolBind f == symbol >>= f

    Observe that we can now remove the Symbol constructor as well since we have

      symbol == symbol >>= return (by L2)
             == SymbolBind return
-}
data P s a where
  Fail       :: P s a
  (:+++)     :: P s a -> P s a -> P s a
  Return     :: a -> P s a
  SymbolBind :: (s -> P s a) -> P s a -- SymbolBind f = symbol >>= f

symbol :: P s s
symbol = SymbolBind Return

pfail :: P s a
pfail  = Fail

(+++) :: P s a -> P s a -> P s a
(+++)  = (:+++)

instance Monad (P s) where
  return = Return

  -- Using the laws we can calculate the definition of >>=
  Fail         >>= f = Fail                         -- by L4
  Return x     >>= f = f x                          -- by L1
  (p :+++ q)   >>= f = (p >>= f) +++ (q >>= f)      -- by L5
  SymbolBind k >>= f = SymbolBind (\x -> k x >>= f) -- by L3 and def. of SymbolBind

{-| Similarly we can calculate the definition of the run function for the new
    constructor by going back to the previous run function:

      parse (SymbolBind f) (c:s)                ==
      parse (Symbol :>>= f) (c:s)               ==
      [ (y, s'') | (x, s') <- parse Symbol (c:s)
                 , (y, s'') <- parse (f x) s'
      ]                                         ==
      [ (y, s'') | (x, s') <- [(c, s)]
                 , (y, s'') <- parse (f x) s' ] ==
      [ (y, s'') | (y, s'') <- parse (f c) s ]  ==
      parse (f c) s
-}
parse :: P s a -> [s] -> ParseResult s a
parse (SymbolBind f) (c : s) = parse (f c) s
parse (SymbolBind f) []      = []
parse Fail       _           = []
parse (p :+++ q) s           = parse p s ++ parse q s
parse (Return x) s           = [(x, s)]

-- Now the list comprehension is gone. Next up is the list concatenation.