{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.Beam.User where

import Data.Text qualified as T
import Database.Beam
import Optics
import WikiMusic.Beam.Util
import WikiMusic.Model.Genre
import WikiMusic.Protolude

data UserT f = User'
  { forall (f :: * -> *). UserT f -> C f Text
identifier :: C f Text,
    forall (f :: * -> *). UserT f -> C f Text
displayName :: C f Text,
    forall (f :: * -> *). UserT f -> C f Text
emailAddress :: C f Text,
    forall (f :: * -> *). UserT f -> C f (Maybe Text)
passwordHash :: C f (Maybe Text),
    forall (f :: * -> *). UserT f -> C f (Maybe Text)
passwordResetToken :: C f (Maybe Text),
    forall (f :: * -> *). UserT f -> C f (Maybe Text)
authToken :: C f (Maybe Text),
    forall (f :: * -> *). UserT f -> C f (Maybe UTCTime)
latestLoginAt :: C f (Maybe UTCTime),
    forall (f :: * -> *). UserT f -> C f (Maybe Text)
latestLoginDevice :: C f (Maybe Text),
    forall (f :: * -> *). UserT f -> C f (Maybe Text)
avatarUrl :: C f (Maybe Text),
    forall (f :: * -> *). UserT f -> C f UTCTime
createdAt :: C f UTCTime,
    forall (f :: * -> *). UserT f -> C f (Maybe UTCTime)
lastEditedAt :: C f (Maybe UTCTime),
    forall (f :: * -> *). UserT f -> C f (Maybe Text)
description :: C f (Maybe Text)
  }
  deriving ((forall x. UserT f -> Rep (UserT f) x)
-> (forall x. Rep (UserT f) x -> UserT f) -> Generic (UserT f)
forall x. Rep (UserT f) x -> UserT f
forall x. UserT f -> Rep (UserT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (UserT f) x -> UserT f
forall (f :: * -> *) x. UserT f -> Rep (UserT f) x
$cfrom :: forall (f :: * -> *) x. UserT f -> Rep (UserT f) x
from :: forall x. UserT f -> Rep (UserT f) x
$cto :: forall (f :: * -> *) x. Rep (UserT f) x -> UserT f
to :: forall x. Rep (UserT f) x -> UserT f
Generic, TableSkeleton UserT
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> UserT f -> UserT g -> m (UserT h))
-> TableSkeleton UserT -> Beamable UserT
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> UserT f -> UserT g -> m (UserT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> UserT f -> UserT g -> m (UserT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> UserT f -> UserT g -> m (UserT h)
$ctblSkeleton :: TableSkeleton UserT
tblSkeleton :: TableSkeleton UserT
Beamable)

makeFieldLabelsNoPrefix ''UserT

type User' = UserT Identity

instance Table UserT where
  data PrimaryKey UserT f = UserId (Columnar f Text) deriving ((forall x. PrimaryKey UserT f -> Rep (PrimaryKey UserT f) x)
-> (forall x. Rep (PrimaryKey UserT f) x -> PrimaryKey UserT f)
-> Generic (PrimaryKey UserT f)
forall x. Rep (PrimaryKey UserT f) x -> PrimaryKey UserT f
forall x. PrimaryKey UserT f -> Rep (PrimaryKey UserT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey UserT f) x -> PrimaryKey UserT f
forall (f :: * -> *) x.
PrimaryKey UserT f -> Rep (PrimaryKey UserT f) x
$cfrom :: forall (f :: * -> *) x.
PrimaryKey UserT f -> Rep (PrimaryKey UserT f) x
from :: forall x. PrimaryKey UserT f -> Rep (PrimaryKey UserT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey UserT f) x -> PrimaryKey UserT f
to :: forall x. Rep (PrimaryKey UserT f) x -> PrimaryKey UserT f
Generic, TableSkeleton (PrimaryKey UserT)
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> PrimaryKey UserT f
 -> PrimaryKey UserT g
 -> m (PrimaryKey UserT h))
-> TableSkeleton (PrimaryKey UserT) -> Beamable (PrimaryKey UserT)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey UserT f
-> PrimaryKey UserT g
-> m (PrimaryKey UserT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey UserT f
-> PrimaryKey UserT g
-> m (PrimaryKey UserT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey UserT f
-> PrimaryKey UserT g
-> m (PrimaryKey UserT h)
$ctblSkeleton :: TableSkeleton (PrimaryKey UserT)
tblSkeleton :: TableSkeleton (PrimaryKey UserT)
Beamable)
  primaryKey :: forall (column :: * -> *). UserT column -> PrimaryKey UserT column
primaryKey = Columnar column Text -> PrimaryKey UserT column
forall (f :: * -> *). Columnar f Text -> PrimaryKey UserT f
UserId (Columnar column Text -> PrimaryKey UserT column)
-> (UserT column -> Columnar column Text)
-> UserT column
-> PrimaryKey UserT column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserT column
-> Optic' A_Lens NoIx (UserT column) (Columnar column Text)
-> Columnar column Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (UserT column) (Columnar column Text)
#identifier)

userTModification :: UserT (FieldModification (TableField UserT))
userTModification :: UserT (FieldModification (TableField UserT))
userTModification =
  UserT (FieldModification (TableField UserT))
forall (f :: * -> *) (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (FieldModification f)
tableModification
    { identifier = "identifier",
      displayName = "display_name",
      emailAddress = "email_address",
      passwordHash = "password_hash",
      passwordResetToken = "password_reset_token",
      authToken = "auth_token",
      latestLoginAt = "latest_login_at",
      latestLoginDevice = "latest_login_device",
      avatarUrl = "avatar_url",
      createdAt = "created_at",
      lastEditedAt = "last_edited_at"
    }

data UserRoleT f = UserRole'
  { forall (f :: * -> *). UserRoleT f -> C f Text
identifier :: C f Text,
    forall (f :: * -> *). UserRoleT f -> PrimaryKey UserT f
userIdentifier :: PrimaryKey UserT f,
    forall (f :: * -> *). UserRoleT f -> C f Text
roleId :: C f Text,
    forall (f :: * -> *). UserRoleT f -> C f UTCTime
createdAt :: C f UTCTime
  }
  deriving ((forall x. UserRoleT f -> Rep (UserRoleT f) x)
-> (forall x. Rep (UserRoleT f) x -> UserRoleT f)
-> Generic (UserRoleT f)
forall x. Rep (UserRoleT f) x -> UserRoleT f
forall x. UserRoleT f -> Rep (UserRoleT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (UserRoleT f) x -> UserRoleT f
forall (f :: * -> *) x. UserRoleT f -> Rep (UserRoleT f) x
$cfrom :: forall (f :: * -> *) x. UserRoleT f -> Rep (UserRoleT f) x
from :: forall x. UserRoleT f -> Rep (UserRoleT f) x
$cto :: forall (f :: * -> *) x. Rep (UserRoleT f) x -> UserRoleT f
to :: forall x. Rep (UserRoleT f) x -> UserRoleT f
Generic, TableSkeleton UserRoleT
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> UserRoleT f -> UserRoleT g -> m (UserRoleT h))
-> TableSkeleton UserRoleT -> Beamable UserRoleT
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> UserRoleT f -> UserRoleT g -> m (UserRoleT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> UserRoleT f -> UserRoleT g -> m (UserRoleT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> UserRoleT f -> UserRoleT g -> m (UserRoleT h)
$ctblSkeleton :: TableSkeleton UserRoleT
tblSkeleton :: TableSkeleton UserRoleT
Beamable)

makeFieldLabelsNoPrefix ''UserRoleT

type UserRole' = UserRoleT Identity

instance Table UserRoleT where
  data PrimaryKey UserRoleT f = UserRoleId (Columnar f Text) deriving ((forall x.
 PrimaryKey UserRoleT f -> Rep (PrimaryKey UserRoleT f) x)
-> (forall x.
    Rep (PrimaryKey UserRoleT f) x -> PrimaryKey UserRoleT f)
-> Generic (PrimaryKey UserRoleT f)
forall x. Rep (PrimaryKey UserRoleT f) x -> PrimaryKey UserRoleT f
forall x. PrimaryKey UserRoleT f -> Rep (PrimaryKey UserRoleT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey UserRoleT f) x -> PrimaryKey UserRoleT f
forall (f :: * -> *) x.
PrimaryKey UserRoleT f -> Rep (PrimaryKey UserRoleT f) x
$cfrom :: forall (f :: * -> *) x.
PrimaryKey UserRoleT f -> Rep (PrimaryKey UserRoleT f) x
from :: forall x. PrimaryKey UserRoleT f -> Rep (PrimaryKey UserRoleT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey UserRoleT f) x -> PrimaryKey UserRoleT f
to :: forall x. Rep (PrimaryKey UserRoleT f) x -> PrimaryKey UserRoleT f
Generic, TableSkeleton (PrimaryKey UserRoleT)
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> PrimaryKey UserRoleT f
 -> PrimaryKey UserRoleT g
 -> m (PrimaryKey UserRoleT h))
-> TableSkeleton (PrimaryKey UserRoleT)
-> Beamable (PrimaryKey UserRoleT)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey UserRoleT f
-> PrimaryKey UserRoleT g
-> m (PrimaryKey UserRoleT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey UserRoleT f
-> PrimaryKey UserRoleT g
-> m (PrimaryKey UserRoleT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey UserRoleT f
-> PrimaryKey UserRoleT g
-> m (PrimaryKey UserRoleT h)
$ctblSkeleton :: TableSkeleton (PrimaryKey UserRoleT)
tblSkeleton :: TableSkeleton (PrimaryKey UserRoleT)
Beamable)
  primaryKey :: forall (column :: * -> *).
UserRoleT column -> PrimaryKey UserRoleT column
primaryKey = Columnar column Text -> PrimaryKey UserRoleT column
forall (f :: * -> *). Columnar f Text -> PrimaryKey UserRoleT f
UserRoleId (Columnar column Text -> PrimaryKey UserRoleT column)
-> (UserRoleT column -> Columnar column Text)
-> UserRoleT column
-> PrimaryKey UserRoleT column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserRoleT column
-> Optic' A_Lens NoIx (UserRoleT column) (Columnar column Text)
-> Columnar column Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (UserRoleT column) (Columnar column Text)
#identifier)

userRoleTModification :: UserRoleT (FieldModification (TableField UserRoleT))
userRoleTModification :: UserRoleT (FieldModification (TableField UserRoleT))
userRoleTModification =
  UserRoleT (FieldModification Any)
forall (f :: * -> *) (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (FieldModification f)
tableModification
    { identifier = "identifier",
      userIdentifier = UserId "user_identifier",
      roleId = "role_id",
      createdAt = "created_at"
    }

userRole :: Text -> UserRole
userRole :: Text -> UserRole
userRole = String -> UserRole
forall a. Read a => String -> a
read (String -> UserRole) -> (Text -> String) -> Text -> UserRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

mkUserM :: [Text] -> User' -> WikiMusicUser
mkUserM :: [Text] -> User' -> WikiMusicUser
mkUserM [Text]
roles User'
x =
  WikiMusicUser
    { $sel:identifier:WikiMusicUser :: UUID
identifier = Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ User'
x User' -> Optic' A_Lens NoIx User' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx User' Text
#identifier,
      $sel:displayName:WikiMusicUser :: Text
displayName = User'
x User' -> Optic' A_Lens NoIx User' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx User' Text
#displayName,
      $sel:emailAddress:WikiMusicUser :: Text
emailAddress = User'
x User' -> Optic' A_Lens NoIx User' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx User' Text
#emailAddress,
      $sel:passwordHash:WikiMusicUser :: Maybe Text
passwordHash = User'
x User' -> Optic' A_Lens NoIx User' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx User' (Maybe Text)
#passwordHash,
      $sel:roles:WikiMusicUser :: [UserRole]
roles = (Text -> UserRole) -> [Text] -> [UserRole]
forall a b. (a -> b) -> [a] -> [b]
map Text -> UserRole
userRole [Text]
roles,
      $sel:authToken:WikiMusicUser :: Maybe Text
authToken = User'
x User' -> Optic' A_Lens NoIx User' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx User' (Maybe Text)
#authToken
    }