{-# LANGUAGE CPP #-}
module Database.MSSQLServer.Query.TokenStreamParser ( Parser(..)
, parse
, item
, satisfy
, satisfyNotError
, Parser'(..)
, isTSError
, isTSDoneOrDoneProc
, isTSDone
, isTSDoneProc
, isFinalTSDoneOrDoneProc
, isFinalTSDone
, isFinalTSDoneProc
) where
import Control.Applicative(Applicative((<*>),pure),Alternative((<|>),empty),(<$>))
import Control.Monad(Monad(..),MonadPlus(..),ap)
import Data.Monoid ((<>),mconcat)
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail(MonadFail(..))
#endif
import Database.Tds.Message
import Database.MSSQLServer.Query.Row
import Data.Bits ((.&.))
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except
#else
import Control.Monad.Error
import qualified Data.Text as T
#endif
data Parser a = Parser ([TokenStream] -> [(a,[TokenStream])])
parse :: Parser a -> [TokenStream] -> [(a,[TokenStream])]
parse :: forall a. Parser a -> [TokenStream] -> [(a, [TokenStream])]
parse (Parser [TokenStream] -> [(a, [TokenStream])]
p) = [TokenStream] -> [(a, [TokenStream])]
p
instance Functor Parser where
fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f Parser a
p = forall a. ([TokenStream] -> [(a, [TokenStream])]) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[TokenStream]
xs -> [(a -> b
f a
x,[TokenStream]
xs') | (a
x,[TokenStream]
xs') <- forall a. Parser a -> [TokenStream] -> [(a, [TokenStream])]
parse Parser a
p [TokenStream]
xs]
instance Applicative Parser where
pure :: forall a. a -> Parser a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Alternative Parser where
empty :: forall a. Parser a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance Monad Parser where
return :: forall a. a -> Parser a
return a
x = forall a. ([TokenStream] -> [(a, [TokenStream])]) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[TokenStream]
xs -> [(a
x,[TokenStream]
xs)]
Parser a
p >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
f = forall a. ([TokenStream] -> [(a, [TokenStream])]) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[TokenStream]
ts -> forall a. Monoid a => [a] -> a
mconcat [forall a. Parser a -> [TokenStream] -> [(a, [TokenStream])]
parse (a -> Parser b
f a
t) [TokenStream]
ts' | (a
t,[TokenStream]
ts') <- forall a. Parser a -> [TokenStream] -> [(a, [TokenStream])]
parse Parser a
p [TokenStream]
ts]
instance MonadPlus Parser where
mzero :: forall a. Parser a
mzero = forall a. ([TokenStream] -> [(a, [TokenStream])]) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[TokenStream]
_ -> []
mplus :: forall a. Parser a -> Parser a -> Parser a
mplus Parser a
p Parser a
q = forall a. ([TokenStream] -> [(a, [TokenStream])]) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[TokenStream]
xs -> forall a. Parser a -> [TokenStream] -> [(a, [TokenStream])]
parse Parser a
p [TokenStream]
xs forall a. Semigroup a => a -> a -> a
<> forall a. Parser a -> [TokenStream] -> [(a, [TokenStream])]
parse Parser a
q [TokenStream]
xs
#if MIN_VERSION_base(4,9,0)
instance MonadFail Parser where
fail :: forall a. String -> Parser a
fail String
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero
#endif
item :: Parser TokenStream
item :: Parser TokenStream
item = forall a. ([TokenStream] -> [(a, [TokenStream])]) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \[TokenStream]
xs -> case [TokenStream]
xs of
[] -> []
(TokenStream
x:[TokenStream]
xs') -> [(TokenStream
x,[TokenStream]
xs')]
satisfy :: (TokenStream -> Bool) -> Parser TokenStream
satisfy :: (TokenStream -> Bool) -> Parser TokenStream
satisfy TokenStream -> Bool
f = do TokenStream
x <- Parser TokenStream
item
if TokenStream -> Bool
f TokenStream
x
then forall (m :: * -> *) a. Monad m => a -> m a
return TokenStream
x
else forall (f :: * -> *) a. Alternative f => f a
empty
satisfyNotError :: (TokenStream -> Bool) -> Parser TokenStream
satisfyNotError :: (TokenStream -> Bool) -> Parser TokenStream
satisfyNotError TokenStream -> Bool
f = (TokenStream -> Bool) -> Parser TokenStream
satisfy (\TokenStream
x -> TokenStream -> Bool
f TokenStream
x Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenStream -> Bool
isTSError) TokenStream
x)
#if MIN_VERSION_mtl(2,2,1)
type Parser' = ExceptT Info Parser
#else
type Parser' = ErrorT Info Parser
instance Error Info where
noMsg = Info 0 0 0 (T.pack "") (T.pack "") (T.pack "") 0
#endif
isTSError :: TokenStream -> Bool
isTSError :: TokenStream -> Bool
isTSError (TSError{}) = Bool
True
isTSError TokenStream
_ = Bool
False
isTSDoneOrDoneProc :: TokenStream -> Bool
isTSDoneOrDoneProc :: TokenStream -> Bool
isTSDoneOrDoneProc (TSDone{}) = Bool
True
isTSDoneOrDoneProc (TSDoneProc{}) = Bool
True
isTSDoneOrDoneProc TokenStream
_ = Bool
False
isTSDone :: TokenStream -> Bool
isTSDone :: TokenStream -> Bool
isTSDone (TSDone{}) = Bool
True
isTSDone TokenStream
_ = Bool
False
isTSDoneProc :: TokenStream -> Bool
isTSDoneProc :: TokenStream -> Bool
isTSDoneProc (TSDoneProc{}) = Bool
True
isTSDoneProc TokenStream
_ = Bool
False
isFinalTSDoneOrDoneProc :: TokenStream -> Bool
isFinalTSDoneOrDoneProc :: TokenStream -> Bool
isFinalTSDoneOrDoneProc = Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenStream -> Bool
isFinalTSDone forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TokenStream -> Bool
isFinalTSDoneProc
isFinalTSDone :: TokenStream -> Bool
isFinalTSDone :: TokenStream -> Bool
isFinalTSDone = TokenStream -> Bool
f
where
f :: TokenStream -> Bool
f :: TokenStream -> Bool
f (TSDone Done
x) = Done -> Bool
isFinalDone Done
x
f TokenStream
_ = Bool
False
isFinalTSDoneProc :: TokenStream -> Bool
isFinalTSDoneProc :: TokenStream -> Bool
isFinalTSDoneProc = TokenStream -> Bool
f
where
f :: TokenStream -> Bool
f :: TokenStream -> Bool
f (TSDoneProc Done
x) = Done -> Bool
isFinalDone Done
x
f TokenStream
_ = Bool
False
isFinalDone :: Done -> Bool
isFinalDone :: Done -> Bool
isFinalDone (Done DoneStatus
st DoneStatus
_ DoneRowCount
_) = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ DoneStatus
st forall a. Bits a => a -> a -> a
.&. DoneStatus
0x01 forall a. Eq a => a -> a -> Bool
== DoneStatus
0x01