-- | Small parsec-like module
module L3.Parse.Parsec where

import Control.Applicative hiding (many, some)
import Control.Monad
import Data.Char
import L3.Log.Logging
import L3.Parse.Parser
import L3.Util

unParser :: Parser i o -> (i -> [(o, i)])
unParser :: Parser i o -> i -> [(o, i)]
unParser (Parser i -> [(o, i)]
fn) = i -> [(o, i)]
fn

runParser :: (Alternative f, Show (f i), Show o, Eq (f i)) => Parser (f i) o -> f i -> Result o
runParser :: Parser (f i) o -> f i -> Result o
runParser Parser (f i) o
m f i
s =
  case Parser (f i) o -> f i -> [(o, f i)]
forall i o. Parser i o -> i -> [(o, i)]
parse Parser (f i) o
m f i
s of
    [(o
res, f i
rem')] | f i
rem' f i -> f i -> Bool
forall a. Eq a => a -> a -> Bool
== f i
forall (f :: * -> *) a. Alternative f => f a
empty -> o -> Result o
forall a b. b -> Either a b
Right o
res
    [(o
res, f i
rem')] -> Error -> Result o
forall a b. a -> Either a b
Left (Error -> Result o) -> Error -> Result o
forall a b. (a -> b) -> a -> b
$ [String] -> Error
throwError [String
"parser did consume:", o -> String
forall a. Show a => a -> String
showIndent o
res, String
"but failed to consume:", f i -> String
forall a. Show a => a -> String
showIndent f i
rem']
    [] -> Error -> Result o
forall a b. a -> Either a b
Left (Error -> Result o) -> Error -> Result o
forall a b. (a -> b) -> a -> b
$ [String] -> Error
throwError [String
"parser failed to consume anything from:", f i -> String
forall a. Show a => a -> String
showIndent f i
s]
    [(o, f i)]
rs -> Error -> Result o
forall a b. a -> Either a b
Left (Error -> Result o) -> Error -> Result o
forall a b. (a -> b) -> a -> b
$ [String] -> Error
throwError (String
"parser produced multiple results:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((o, f i) -> String) -> [(o, f i)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (o, f i) -> String
forall a. Show a => a -> String
showIndent [(o, f i)]
rs)

some :: (Alternative f) => f a -> f [a]
some :: f a -> f [a]
some f a
v = f [a]
some_v
  where
    many_v :: f [a]
many_v = f [a]
some_v f [a] -> f [a] -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    some_v :: f [a]
some_v = (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
v f ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [a]
many_v

many :: (Alternative f) => f a -> f [a]
many :: f a -> f [a]
many f a
v = f [a]
many_v
  where
    many_v :: f [a]
many_v = f [a]
some_v f [a] -> f [a] -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    some_v :: f [a]
some_v = (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
v f ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [a]
many_v

chainl :: Parser i o -> Parser i (o -> o -> o) -> o -> Parser i o
chainl :: Parser i o -> Parser i (o -> o -> o) -> o -> Parser i o
chainl Parser i o
p Parser i (o -> o -> o)
op o
a = (Parser i o
p Parser i o -> Parser i (o -> o -> o) -> Parser i o
forall i o. Parser i o -> Parser i (o -> o -> o) -> Parser i o
`chainl1` Parser i (o -> o -> o)
op) Parser i o -> Parser i o -> Parser i o
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> o -> Parser i o
forall (m :: * -> *) a. Monad m => a -> m a
return o
a

chainl1 :: Parser i o -> Parser i (o -> o -> o) -> Parser i o
Parser i o
p chainl1 :: Parser i o -> Parser i (o -> o -> o) -> Parser i o
`chainl1` Parser i (o -> o -> o)
op = do o
a <- Parser i o
p; o -> Parser i o
rest o
a
  where
    rest :: o -> Parser i o
rest o
a =
      ( do
          o -> o -> o
f <- Parser i (o -> o -> o)
op
          o
b <- Parser i o
p
          o -> Parser i o
rest (o -> o -> o
f o
a o
b)
      )
        Parser i o -> Parser i o -> Parser i o
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> o -> Parser i o
forall (m :: * -> *) a. Monad m => a -> m a
return o
a