{-# 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