{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.Sqlite.UserQuery () where

import Database.Beam
import Database.Beam.Sqlite
import Optics
import Relude
import WikiMusic.Beam.Database
import WikiMusic.Free.UserQuery
import WikiMusic.Protolude

instance Exec UserQuery where
  execAlgebra :: forall a. UserQuery (IO a) -> IO a
execAlgebra (DoesTokenMatchByEmail Env
env UserEmail
email UserToken
token Either UserQueryError Bool -> IO a
next) = Either UserQueryError Bool -> IO a
next (Either UserQueryError Bool -> IO a)
-> IO (Either UserQueryError Bool) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UserEmail -> UserToken -> IO (Either UserQueryError Bool)
forall (m :: * -> *).
MonadIO m =>
Env -> UserEmail -> UserToken -> m (Either UserQueryError Bool)
doesTokenMatchByEmail' Env
env UserEmail
email UserToken
token

doesTokenMatchByEmail' :: (MonadIO m) => Env -> UserEmail -> UserToken -> m (Either UserQueryError Bool)
doesTokenMatchByEmail' :: forall (m :: * -> *).
MonadIO m =>
Env -> UserEmail -> UserToken -> m (Either UserQueryError Bool)
doesTokenMatchByEmail' Env
env UserEmail
email UserToken
token = do
  Maybe (UserT Identity)
maybeUser <- IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Maybe (UserT Identity)) -> m (Maybe (UserT Identity)))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> IO (Maybe (UserT Identity)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> m (Maybe (UserT Identity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ())
-> Connection
-> SqliteM (Maybe (UserT Identity))
-> IO (Maybe (UserT Identity))
forall a. (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (Env
env Env -> Optic' A_Lens NoIx Env Connection -> Connection
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Connection
#conn)
    (SqliteM (Maybe (UserT Identity)) -> IO (Maybe (UserT Identity)))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> SqliteM (Maybe (UserT Identity)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> IO (Maybe (UserT Identity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite (UserT Identity)
-> SqliteM (Maybe (UserT Identity))
forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningFirst
    (SqlSelect Sqlite (UserT Identity)
 -> SqliteM (Maybe (UserT Identity)))
-> (Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope))
    -> SqlSelect Sqlite (UserT Identity))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> SqliteM (Maybe (UserT Identity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  WikiMusicDatabase
  QBaseScope
  (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect
     Sqlite (QExprToIdentity (UserT (QExpr Sqlite QBaseScope)))
Q Sqlite
  WikiMusicDatabase
  QBaseScope
  (UserT (QExpr Sqlite QBaseScope))
-> SqlSelect Sqlite (UserT Identity)
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select
    (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> m (Maybe (UserT Identity)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> m (Maybe (UserT Identity))
forall a b. (a -> b) -> a -> b
$ do
      (UserT (QExpr Sqlite QBaseScope) -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_
        ( \UserT (QExpr Sqlite QBaseScope)
s ->
            ((UserT (QExpr Sqlite QBaseScope)
s UserT (QExpr Sqlite QBaseScope)
-> Optic'
     A_Lens
     NoIx
     (UserT (QExpr Sqlite QBaseScope))
     (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (UserT (QExpr Sqlite QBaseScope))
  (QGenExpr QValueContext Sqlite QBaseScope Text)
#emailAddress) QGenExpr QValueContext Sqlite QBaseScope Text
-> QGenExpr QValueContext Sqlite QBaseScope Text
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope Text)
-> QGenExpr QValueContext Sqlite QBaseScope Text
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (UserEmail
email UserEmail
-> Optic'
     An_Iso
     NoIx
     UserEmail
     (HaskellLiteralForQExpr
        (QGenExpr QValueContext Sqlite QBaseScope Text))
-> HaskellLiteralForQExpr
     (QGenExpr QValueContext Sqlite QBaseScope Text)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso
  NoIx
  UserEmail
  (HaskellLiteralForQExpr
     (QGenExpr QValueContext Sqlite QBaseScope Text))
#value))
              QExpr Sqlite QBaseScope Bool
-> QExpr Sqlite QBaseScope Bool -> QExpr Sqlite QBaseScope Bool
forall be context s.
BeamSqlBackend be =>
QGenExpr context be s Bool
-> QGenExpr context be s Bool -> QGenExpr context be s Bool
&&. ((UserT (QExpr Sqlite QBaseScope)
s UserT (QExpr Sqlite QBaseScope)
-> Optic'
     A_Lens
     NoIx
     (UserT (QExpr Sqlite QBaseScope))
     (QGenExpr QValueContext Sqlite QBaseScope (Maybe Text))
-> QGenExpr QValueContext Sqlite QBaseScope (Maybe Text)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (UserT (QExpr Sqlite QBaseScope))
  (QGenExpr QValueContext Sqlite QBaseScope (Maybe Text))
#passwordResetToken) QGenExpr QValueContext Sqlite QBaseScope (Maybe Text)
-> QGenExpr QValueContext Sqlite QBaseScope (Maybe Text)
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope (Maybe Text))
-> QGenExpr QValueContext Sqlite QBaseScope (Maybe Text)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (Text -> Maybe Text
forall a. a -> Maybe a
Just (UserToken
token UserToken -> Optic' An_Iso NoIx UserToken Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx UserToken Text
#value)))
        )
        (Q Sqlite
   WikiMusicDatabase
   QBaseScope
   (UserT (QExpr Sqlite QBaseScope))
 -> Q Sqlite
      WikiMusicDatabase
      QBaseScope
      (UserT (QExpr Sqlite QBaseScope)))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
-> Q Sqlite
     WikiMusicDatabase
     QBaseScope
     (UserT (QExpr Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ ((DatabaseSettings Sqlite WikiMusicDatabase
-> Optic'
     A_Lens
     NoIx
     (DatabaseSettings Sqlite WikiMusicDatabase)
     (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
-> DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (DatabaseSettings Sqlite WikiMusicDatabase)
  (DatabaseEntity Sqlite WikiMusicDatabase (TableEntity UserT))
#users) DatabaseSettings Sqlite WikiMusicDatabase
forall be. DatabaseSettings be WikiMusicDatabase
wikiMusicDatabase)

  Either UserQueryError Bool -> m (Either UserQueryError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserQueryError Bool -> m (Either UserQueryError Bool))
-> (Bool -> Either UserQueryError Bool)
-> Bool
-> m (Either UserQueryError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either UserQueryError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either UserQueryError Bool))
-> Bool -> m (Either UserQueryError Bool)
forall a b. (a -> b) -> a -> b
$ Maybe (UserT Identity) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (UserT Identity)
maybeUser

-- getUsers' :: (MonadIO m) => Env -> m (Either UserQueryError [User])
-- getUsers' env = do
--   users <- liftIO
--     . runBeamSqliteDebug putStrLn (env ^. #conn)
--     . runSelectReturningList
--     . select
--     $ do
--       u <-
--         orderBy_ (asc_ . (^. #displayName))
--           $ filter_
--             (\s -> (s ^. #authToken) /=. val_ (Just ""))
--           $ all_ ((^. #users) wikiMusicDatabase)

--       r <-
--         oneToMany_ ((^. #userRoles) wikiMusicDatabase) (UserId . (^. #identifier)) u

--       pure (u, r)

--   -- let uu = (uncurry mkUserM)
--   -- pure . Right $ map uu users
--   -- let rr = groupBy ((==) `on` fst) $ users
--   -- let noneRR = mapMaybe nonEmpty rr
--   -- let noneRRR = map (\x -> do
--   --                       x
--   --                   ) noneRR
--   -- let roleMap = map (\l -> (fst . head $ l, map snd l)) . catMaybes . map (\(u, r) -> (nonEmpty u, r)) $ rr
--   pure . Right $ []