> module Language.Haskell.Her.Parsley where
> import Data.Char
> import Control.Applicative
> import Control.Monad
> import Control.Monad.State
> (<*^) :: Applicative f => f (a -> b) -> a -> f b
> f <*^ s = f <*> pure s
> newtype P t x = P {runP :: [t] -> Maybe ([t], x, [t])}
> instance Monad (P t) where
> return x = P $ \ ts -> Just ([], x, ts)
> P s >>= f = P $ \ts -> do
> (sts, s', ts) <- s ts
> (tts, t', ts) <- runP (f s') ts
> return (sts ++ tts, t', ts)
> parse :: P t x -> [t] -> Maybe x
> parse p ts = case runP p ts of
> Just (_, x, []) -> Just x
> _ -> Nothing
> instance Functor (P t) where
> fmap = ap . return
> instance Applicative (P t) where
> pure = return
> (<*>) = ap
> instance Alternative (P t) where
> empty = P $ \ _ -> Nothing
> p <|> q = P $ \ ts -> runP p ts <|> runP q ts
> pRest :: P t [t]
> pRest = P $ \ ts -> Just (ts, ts, [])
> pEnd :: P t ()
> pEnd = P $ \ ts -> if null ts then Just ([], (), []) else Nothing
> next :: P t t
> next = P $ \ ts -> case ts of
> [] -> Nothing
> (t : ts) -> Just ([t], t, ts)
> pExt :: P t x -> P t ([t], x)
> pExt (P x) = P $ \ ts -> do
> (xts, x', ts) <- x ts
> return (xts, (xts, x'), ts)
> pOpt :: P t x -> P t (Maybe x)
> pOpt p = Just <$> p <|> pure Nothing
>
> pStar :: P t x -> P t [x]
> pStar p = pPlus p <|> pure []
> }
> pSep :: P t s -> P t x -> P t [x]
> pSep s p = (:) <$> p <*> many (s *> p) <|> pure []
> grok :: (a -> Maybe b) -> P t a -> P t b
> grok f p = do
> a <- p
> case f a of
> Just b -> return b
> Nothing -> empty
> ok :: (a -> Bool) -> a -> Maybe a
> ok p a = guard (p a) >> return a
> tok :: (t -> Bool) -> P t t
> tok p = grok (ok p) next
> teq :: Eq t => t -> P t ()
> teq t = tok (== t) *> pure ()