{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE BangPatterns #-}
module Monitor.DB where

import Data.ByteString (ByteString)
import qualified Data.Vector as V

import qualified Hasql.Session as HaSQL
import qualified Hasql.Statement as HaSQL
import qualified Hasql.Decoders as D
import qualified Hasql.Encoders as E

import Monitor.DataModel

decodeAssertResultless :: D.Result Bool
decodeAssertResultless :: Result Bool
decodeAssertResultless = (\() -> Bool
True) (() -> Bool) -> Result () -> Result Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result ()
D.noResult

decodeAssertNull :: D.Result Bool
decodeAssertNull :: Result Bool
decodeAssertNull = [Maybe ()] -> Bool
forall a. [Maybe a] -> Bool
test ([Maybe ()] -> Bool)
-> (Vector (Maybe ()) -> [Maybe ()]) -> Vector (Maybe ()) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Maybe ()) -> [Maybe ()]
forall a. Vector a -> [a]
V.toList (Vector (Maybe ()) -> Bool)
-> Result (Vector (Maybe ())) -> Result Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Maybe ()) -> Result (Vector (Maybe ()))
forall a. Row a -> Result (Vector a)
D.rowVector (NullableOrNot Value (Maybe ()) -> Row (Maybe ())
forall a. NullableOrNot Value a -> Row a
D.column (Value () -> NullableOrNot Value (Maybe ())
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
D.nullable ((Bool -> ByteString -> Either Text ()) -> Value ()
forall a. (Bool -> ByteString -> Either Text a) -> Value a
D.custom (\Bool
_ ByteString
_ -> () -> Either Text ()
forall a b. b -> Either a b
Right ()))))
  where
    test :: [Maybe a] -> Bool
test [] = Bool
True
    test [Maybe a
Nothing] = Bool
True
    test [Maybe a]
_ = Bool
False

decodeAssertNotNull :: D.Result Bool
decodeAssertNotNull :: Result Bool
decodeAssertNotNull = Bool -> Bool
not (Bool -> Bool) -> Result Bool -> Result Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result Bool
decodeAssertNull

decodeAssertTrue :: D.Result Bool
decodeAssertTrue :: Result Bool
decodeAssertTrue = Maybe (Maybe Bool) -> Bool
test (Maybe (Maybe Bool) -> Bool)
-> Result (Maybe (Maybe Bool)) -> Result Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Maybe Bool) -> Result (Maybe (Maybe Bool))
forall a. Row a -> Result (Maybe a)
D.rowMaybe (NullableOrNot Value (Maybe Bool) -> Row (Maybe Bool)
forall a. NullableOrNot Value a -> Row a
D.column (Value Bool -> NullableOrNot Value (Maybe Bool)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
D.nullable Value Bool
D.bool))
  where
    test :: Maybe (Maybe Bool) -> Bool
test Maybe (Maybe Bool)
Nothing = Bool
False
    test (Just Maybe Bool
Nothing) = Bool
False
    test (Just (Just Bool
a)) = Bool
a

decodeAssertFalse :: D.Result Bool
decodeAssertFalse :: Result Bool
decodeAssertFalse = Maybe (Maybe Bool) -> Bool
test (Maybe (Maybe Bool) -> Bool)
-> Result (Maybe (Maybe Bool)) -> Result Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Maybe Bool) -> Result (Maybe (Maybe Bool))
forall a. Row a -> Result (Maybe a)
D.rowMaybe (NullableOrNot Value (Maybe Bool) -> Row (Maybe Bool)
forall a. NullableOrNot Value a -> Row a
D.column (Value Bool -> NullableOrNot Value (Maybe Bool)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
D.nullable Value Bool
D.bool))
  where
    test :: Maybe (Maybe Bool) -> Bool
test Maybe (Maybe Bool)
Nothing = Bool
False
    test (Just Maybe Bool
Nothing) = Bool
False
    test (Just (Just Bool
a)) = Bool -> Bool
not Bool
a

decodeAssertZero :: D.Result Bool
decodeAssertZero :: Result Bool
decodeAssertZero = Maybe (Maybe Int32) -> Bool
forall a. (Eq a, Num a) => Maybe (Maybe a) -> Bool
test (Maybe (Maybe Int32) -> Bool)
-> Result (Maybe (Maybe Int32)) -> Result Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row (Maybe Int32) -> Result (Maybe (Maybe Int32))
forall a. Row a -> Result (Maybe a)
D.rowMaybe (NullableOrNot Value (Maybe Int32) -> Row (Maybe Int32)
forall a. NullableOrNot Value a -> Row a
D.column (Value Int32 -> NullableOrNot Value (Maybe Int32)
forall (decoder :: * -> *) a.
decoder a -> NullableOrNot decoder (Maybe a)
D.nullable Value Int32
D.int4))
  where
    test :: Maybe (Maybe a) -> Bool
test Maybe (Maybe a)
Nothing = Bool
False
    test (Just Maybe a
Nothing) = Bool
False
    test (Just (Just a
a)) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0

session :: Assertion -> ByteString -> HaSQL.Session Bool
session :: Assertion -> ByteString -> Session Bool
session Assertion
assertion ByteString
sql = () -> Statement () Bool -> Session Bool
forall params result.
params -> Statement params result -> Session result
HaSQL.statement () (Statement () Bool -> Session Bool)
-> Statement () Bool -> Session Bool
forall a b. (a -> b) -> a -> b
$ case Assertion
assertion of
  Assertion
AssertNull -> ByteString -> Params () -> Result Bool -> Bool -> Statement () Bool
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
HaSQL.Statement ByteString
sql Params ()
E.noParams Result Bool
decodeAssertNull Bool
False
  Assertion
AssertNotNull -> ByteString -> Params () -> Result Bool -> Bool -> Statement () Bool
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
HaSQL.Statement ByteString
sql Params ()
E.noParams Result Bool
decodeAssertNotNull Bool
False
  Assertion
AssertZero -> ByteString -> Params () -> Result Bool -> Bool -> Statement () Bool
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
HaSQL.Statement ByteString
sql Params ()
E.noParams Result Bool
decodeAssertZero Bool
False
  Assertion
AssertTrue -> ByteString -> Params () -> Result Bool -> Bool -> Statement () Bool
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
HaSQL.Statement ByteString
sql Params ()
E.noParams Result Bool
decodeAssertTrue Bool
False
  Assertion
AssertFalse -> ByteString -> Params () -> Result Bool -> Bool -> Statement () Bool
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
HaSQL.Statement ByteString
sql Params ()
E.noParams Result Bool
decodeAssertFalse Bool
False
  Assertion
AssertResultless -> ByteString -> Params () -> Result Bool -> Bool -> Statement () Bool
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
HaSQL.Statement ByteString
sql Params ()
E.noParams Result Bool
decodeAssertResultless Bool
False

runSQL :: PureJob -> Monitor JobFeedback
runSQL :: PureJob -> Monitor JobFeedback
runSQL PureJob{String
ByteString
Assertion
pureJobSQL :: PureJob -> ByteString
pureJobAssertion :: PureJob -> Assertion
pureJobDescription :: PureJob -> String
pureJobSQL :: ByteString
pureJobAssertion :: Assertion
pureJobDescription :: String
..} = do
  Connection
conn <- (Settings -> Connection) -> Monitor Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> Connection
dbConnection
  !Either QueryError Bool
result <- IO (Either QueryError Bool) -> Monitor (Either QueryError Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QueryError Bool) -> Monitor (Either QueryError Bool))
-> IO (Either QueryError Bool) -> Monitor (Either QueryError Bool)
forall a b. (a -> b) -> a -> b
$ Session Bool -> Connection -> IO (Either QueryError Bool)
forall a. Session a -> Connection -> IO (Either QueryError a)
HaSQL.run (Assertion -> ByteString -> Session Bool
session Assertion
pureJobAssertion ByteString
pureJobSQL) Connection
conn
  JobFeedback -> Monitor JobFeedback
forall (m :: * -> *) a. Monad m => a -> m a
return (JobFeedback -> Monitor JobFeedback)
-> JobFeedback -> Monitor JobFeedback
forall a b. (a -> b) -> a -> b
$ case Either QueryError Bool
result of
    Left (HaSQL.QueryError ByteString
_ [Text]
_ (HaSQL.ClientError Maybe ByteString
err)) ->
      String -> JobFeedback
ConnectionError (Maybe ByteString -> String
forall a. Show a => a -> String
show Maybe ByteString
err)
    Left (HaSQL.QueryError ByteString
_ [Text]
_ (HaSQL.ResultError ResultError
err)) ->
      String -> JobFeedback
QueryError (ResultError -> String
forall a. Show a => a -> String
show ResultError
err)
    Right Bool
assertionResult -> Bool -> JobFeedback
AssertionResult Bool
assertionResult