{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Torch.Data.Parser where
import Control.Applicative (Alternative (..), liftA2, optional)
import Control.Monad (MonadPlus, mfilter, replicateM)
import Control.Monad.Logic
import Control.Monad.State (MonadState, StateT (..), get, put)
import Control.Monad.Trans (MonadTrans (lift))
import Control.Monad.Trans.Free (FreeF (..), FreeT (..), iterT, iterTM, wrap)
import Data.Char (isAlpha, isAlphaNum, isDigit, isSpace)
import Data.Foldable (asum)
import Data.Functor (($>))
import Data.Kind (Type)
import Data.List
import qualified Text.Parser.Char as Text
import qualified Text.Parser.Combinators as Text
import qualified Text.Parser.Token as Text
import Text.Read (readMaybe)
type Parser
(b :: Type -> Type)
(i :: Type)
(a :: Type) =
FreeT ((->) i) b a
instance (Applicative f, MonadLogic b, MonadPlus b) => MonadLogic (FreeT f b) where
msplit :: forall a. FreeT f b a -> FreeT f b (Maybe (a, FreeT f b a))
msplit (FreeT b (FreeF f a (FreeT f b a))
b) = forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {f :: * -> *} {a}.
(MonadLogic m, Applicative f, MonadPlus m) =>
m (FreeF f a (FreeT f m a))
-> [f (FreeT f m a)]
-> m (FreeF
f (Maybe (a, FreeT f m a)) (FreeT f m (Maybe (a, FreeT f m a))))
go b (FreeF f a (FreeT f b a))
b []
where
go :: m (FreeF f a (FreeT f m a))
-> [f (FreeT f m a)]
-> m (FreeF
f (Maybe (a, FreeT f m a)) (FreeT f m (Maybe (a, FreeT f m a))))
go m (FreeF f a (FreeT f m a))
b [f (FreeT f m a)]
ws = do
Maybe (FreeF f a (FreeT f m a), m (FreeF f a (FreeT f m a)))
r <- forall (m :: * -> *) a. MonadLogic m => m a -> m (Maybe (a, m a))
msplit m (FreeF f a (FreeT f m a))
b
case Maybe (FreeF f a (FreeT f m a), m (FreeF f a (FreeT f m a)))
r of
Maybe (FreeF f a (FreeT f m a), m (FreeF f a (FreeT f m a)))
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case [f (FreeT f m a)]
ws of
[] -> forall (f :: * -> *) a b. a -> FreeF f a b
Pure forall a. Maybe a
Nothing
(f (FreeT f m a)
w : [f (FreeT f m a)]
ws) ->
let go' :: f [a] -> [f a] -> f [a]
go' f [a]
fas [] = f [a]
fas
go' f [a]
fas (f a
w : [f a]
ws) = f [a] -> [f a] -> f [a]
go' (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) f a
w f [a]
fas) [f a]
ws
in forall (f :: * -> *) a b. f b -> FreeF f a b
Free forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. MonadLogic m => m a -> m (Maybe (a, m a))
msplit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum) (forall {f :: * -> *} {a}. Applicative f => f [a] -> [f a] -> f [a]
go' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure f (FreeT f m a)
w) [f (FreeT f m a)]
ws)
Just (FreeF f a (FreeT f m a)
val, m (FreeF f a (FreeT f m a))
b') ->
case FreeF f a (FreeT f m a)
val of
Pure a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. a -> FreeF f a b
Pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (a
a, forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT m (FreeF f a (FreeT f m a))
b')
Free f (FreeT f m a)
w -> m (FreeF f a (FreeT f m a))
-> [f (FreeT f m a)]
-> m (FreeF
f (Maybe (a, FreeT f m a)) (FreeT f m (Maybe (a, FreeT f m a))))
go m (FreeF f a (FreeT f m a))
b' (f (FreeT f m a)
w forall a. a -> [a] -> [a]
: [f (FreeT f m a)]
ws)
ifte :: forall a b.
FreeT f b a -> (a -> FreeT f b b) -> FreeT f b b -> FreeT f b b
ifte FreeT f b a
t a -> FreeT f b b
th FreeT f b b
el = forall (m :: * -> *) a. MonadLogic m => m a -> m (Maybe (a, m a))
msplit FreeT f b a
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe FreeT f b b
el (\(a
a, FreeT f b a
m) -> a -> FreeT f b b
th a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FreeT f b a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> FreeT f b b
th))
once :: forall a. FreeT f b a -> FreeT f b a
once FreeT f b a
m = do
(a
a, FreeT f b a
_) <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadLogic m => m a -> m (Maybe (a, m a))
msplit FreeT f b a
m
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
lnot :: forall a. FreeT f b a -> FreeT f b ()
lnot FreeT f b a
m = forall (m :: * -> *) a b.
MonadLogic m =>
m a -> (a -> m b) -> m b -> m b
ifte (forall (m :: * -> *) a. MonadLogic m => m a -> m a
once FreeT f b a
m) (forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
empty) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
recurse ::
forall t b i a.
(Parser b i a -> (Parser b i a -> t b a) -> t b a) ->
Parser b i a ->
t b a
recurse :: forall (t :: (* -> *) -> * -> *) (b :: * -> *) i a.
(Parser b i a -> (Parser b i a -> t b a) -> t b a)
-> Parser b i a -> t b a
recurse Parser b i a -> (Parser b i a -> t b a) -> t b a
next Parser b i a
parser =
let cont :: Parser b i a -> t b a
cont = forall (t :: (* -> *) -> * -> *) (b :: * -> *) i a.
(Parser b i a -> (Parser b i a -> t b a) -> t b a)
-> Parser b i a -> t b a
recurse Parser b i a -> (Parser b i a -> t b a) -> t b a
next
in Parser b i a -> (Parser b i a -> t b a) -> t b a
next Parser b i a
parser Parser b i a -> t b a
cont
parseStream :: forall s b i a. Monad b => (s -> b (i, s)) -> Parser (StateT s b) i a -> s -> b (a, s)
parseStream :: forall s (b :: * -> *) i a.
Monad b =>
(s -> b (i, s)) -> Parser (StateT s b) i a -> s -> b (a, s)
parseStream s -> b (i, s)
next = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> FreeT f m a -> m a
iterT (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT s -> b (i, s)
next forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
parseString :: forall b i a. MonadPlus b => Parser (StateT [i] b) i a -> [i] -> b (a, [i])
parseString :: forall (b :: * -> *) i a.
MonadPlus b =>
Parser (StateT [i] b) i a -> [i] -> b (a, [i])
parseString = forall s (b :: * -> *) i a.
Monad b =>
(s -> b (i, s)) -> Parser (StateT s b) i a -> s -> b (a, s)
parseStream (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (a, [a])
uncons)
token :: forall b i. Monad b => Parser b i i
token :: forall (b :: * -> *) i. Monad b => Parser b i i
token = forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. a -> FreeF f a b
Pure
eof :: Alternative b => Parser (StateT [i] b) i ()
eof :: forall (b :: * -> *) i. Alternative b => Parser (StateT [i] b) i ()
eof = forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \[i]
s ->
case [i]
s of
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. a -> FreeF f a b
Pure (), [i]
s)
[i]
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
notFollowedBy ::
forall b i a.
(Alternative b, Foldable b, MonadPlus b) =>
Parser (StateT [i] b) i a ->
Parser (StateT [i] b) i ()
notFollowedBy :: forall (b :: * -> *) i a.
(Alternative b, Foldable b, MonadPlus b) =>
Parser (StateT [i] b) i a -> Parser (StateT [i] b) i ()
notFollowedBy Parser (StateT [i] b) i a
p = forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \[i]
s ->
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (b :: * -> *) i a.
MonadPlus b =>
Parser (StateT [i] b) i a -> [i] -> b (a, [i])
parseString Parser (StateT [i] b) i a
p [i]
s)
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. a -> FreeF f a b
Pure (), [i]
s)
else forall (f :: * -> *) a. Alternative f => f a
empty
instance
(Alternative b, Foldable b, MonadPlus b) =>
Text.Parsing (FreeT ((->) i) (StateT [i] b))
where
try :: forall a.
FreeT ((->) i) (StateT [i] b) a -> FreeT ((->) i) (StateT [i] b) a
try = forall a. a -> a
id
<?> :: forall a.
FreeT ((->) i) (StateT [i] b) a
-> [Char] -> FreeT ((->) i) (StateT [i] b) a
(<?>) = forall a b. a -> b -> a
const
skipMany :: forall a.
FreeT ((->) i) (StateT [i] b) a -> FreeT ((->) i) (StateT [i] b) ()
skipMany FreeT ((->) i) (StateT [i] b) a
p = FreeT ((->) i) (StateT [i] b) ()
scan where scan :: FreeT ((->) i) (StateT [i] b) ()
scan = (FreeT ((->) i) (StateT [i] b) a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> FreeT ((->) i) (StateT [i] b) ()
scan) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
skipSome :: forall a.
FreeT ((->) i) (StateT [i] b) a -> FreeT ((->) i) (StateT [i] b) ()
skipSome FreeT ((->) i) (StateT [i] b) a
p = FreeT ((->) i) (StateT [i] b) a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. Parsing m => m a -> m ()
Text.skipMany FreeT ((->) i) (StateT [i] b) a
p
unexpected :: forall a. [Char] -> FreeT ((->) i) (StateT [i] b) a
unexpected = forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
empty
eof :: FreeT ((->) i) (StateT [i] b) ()
eof = forall (b :: * -> *) i. Alternative b => Parser (StateT [i] b) i ()
Torch.Data.Parser.eof
notFollowedBy :: forall a.
Show a =>
FreeT ((->) i) (StateT [i] b) a -> FreeT ((->) i) (StateT [i] b) ()
notFollowedBy = forall (b :: * -> *) i a.
(Alternative b, Foldable b, MonadPlus b) =>
Parser (StateT [i] b) i a -> Parser (StateT [i] b) i ()
Torch.Data.Parser.notFollowedBy
instance
(Alternative b, Foldable b, MonadPlus b) =>
Text.CharParsing (FreeT ((->) Char) (StateT [Char] b))
where
satisfy :: (Char -> Bool) -> FreeT ((->) Char) (StateT [Char] b) Char
satisfy = forall (b :: * -> *) i. MonadPlus b => (i -> Bool) -> Parser b i i
Torch.Data.Parser.satisfy
char :: Char -> FreeT ((->) Char) (StateT [Char] b) Char
char = forall (b :: * -> *) i. (MonadPlus b, Eq i) => i -> Parser b i i
isToken
notChar :: Char -> FreeT ((->) Char) (StateT [Char] b) Char
notChar = forall (b :: * -> *) i. (MonadPlus b, Eq i) => i -> Parser b i i
isNotToken
anyChar :: FreeT ((->) Char) (StateT [Char] b) Char
anyChar = forall (b :: * -> *) i. Monad b => Parser b i i
token
string :: [Char] -> FreeT ((->) Char) (StateT [Char] b) [Char]
string = forall (t :: * -> *) (b :: * -> *) i.
(Traversable t, MonadPlus b, Eq i) =>
t i -> Parser b i (t i)
isString
instance
(Alternative b, Foldable b, MonadPlus b) =>
Text.TokenParsing (FreeT ((->) Char) (StateT [Char] b))
satisfy :: forall b i. MonadPlus b => (i -> Bool) -> Parser b i i
satisfy :: forall (b :: * -> *) i. MonadPlus b => (i -> Bool) -> Parser b i i
satisfy i -> Bool
p = forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter i -> Bool
p forall (b :: * -> *) i. Monad b => Parser b i i
token
isToken :: forall b i. (MonadPlus b, Eq i) => i -> Parser b i i
isToken :: forall (b :: * -> *) i. (MonadPlus b, Eq i) => i -> Parser b i i
isToken i
i = forall (b :: * -> *) i. MonadPlus b => (i -> Bool) -> Parser b i i
Torch.Data.Parser.satisfy (forall a. Eq a => a -> a -> Bool
== i
i)
isNotToken :: forall b i. (MonadPlus b, Eq i) => i -> Parser b i i
isNotToken :: forall (b :: * -> *) i. (MonadPlus b, Eq i) => i -> Parser b i i
isNotToken i
i = forall (b :: * -> *) i. MonadPlus b => (i -> Bool) -> Parser b i i
Torch.Data.Parser.satisfy (forall a. Eq a => a -> a -> Bool
/= i
i)
scan :: (Alternative m, Monad m) => (s -> a -> Maybe s) -> s -> m a -> m [a]
scan :: forall (m :: * -> *) s a.
(Alternative m, Monad m) =>
(s -> a -> Maybe s) -> s -> m a -> m [a]
scan s -> a -> Maybe s
f s
s m a
p = s -> m [a]
many_p s
s
where
many_p :: s -> m [a]
many_p s
s = s -> m [a]
many1_p s
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
many1_p :: s -> m [a]
many1_p s
s = m a
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
a forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m [a]
many_p) (s -> a -> Maybe s
f s
s a
a)
atMost :: (Alternative m, Monad m) => Int -> m a -> m [a]
atMost :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Int -> m a -> m [a]
atMost Int
n =
let f :: Int -> p -> Maybe Int
f Int
s p
_
| Int
s forall a. Ord a => a -> a -> Bool
>= Int
n = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (Int
s forall a. Num a => a -> a -> a
+ Int
1)
in forall (m :: * -> *) s a.
(Alternative m, Monad m) =>
(s -> a -> Maybe s) -> s -> m a -> m [a]
scan forall {p}. Int -> p -> Maybe Int
f Int
0
eitherP :: Alternative f => f a -> f b -> f (Either a b)
eitherP :: forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
eitherP f a
p f b
p' = (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
p) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
p')
void :: Functor f => f a -> f ()
void :: forall (f :: * -> *) a. Functor f => f a -> f ()
void f a
p = f a
p forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
combine :: (Applicative f, Semigroup a) => f a -> f a -> f a
combine :: forall (f :: * -> *) a.
(Applicative f, Semigroup a) =>
f a -> f a -> f a
combine = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)
combines :: (Applicative f, Monoid a) => [f a] -> f a
combines :: forall (f :: * -> *) a. (Applicative f, Monoid a) => [f a] -> f a
combines = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall (f :: * -> *) a.
(Applicative f, Semigroup a) =>
f a -> f a -> f a
combine (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)
isString :: (Traversable t, MonadPlus b, Eq i) => t i -> Parser b i (t i)
isString :: forall (t :: * -> *) (b :: * -> *) i.
(Traversable t, MonadPlus b, Eq i) =>
t i -> Parser b i (t i)
isString = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (b :: * -> *) i. (MonadPlus b, Eq i) => i -> Parser b i i
isToken
string :: MonadPlus b => Parser b i [i]
string :: forall (b :: * -> *) i. MonadPlus b => Parser b i [i]
string = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall (b :: * -> *) i. Monad b => Parser b i i
token
intP :: (Text.CharParsing m, Monad m) => m Int
intP :: forall (m :: * -> *). (CharParsing m, Monad m) => m Int
intP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall (m :: * -> *). CharParsing m => m Char
Text.digit forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> Maybe a
readMaybe
doubleP :: (Text.CharParsing m, Monad m) => m Double
doubleP :: forall (m :: * -> *). (CharParsing m, Monad m) => m Double
doubleP = forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> Maybe a
readMaybe