{-# 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 -- [MEMO] 0x01 more bit