{-# LANGUAGE Arrows                     #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TypeSynonymInstances       #-}
module Query.User where

import           Control.Arrow                        (returnA, (<<<))
import           Data.Aeson
import           Data.Aeson.Types
import           Data.Maybe
import           Data.Profunctor.Product
import           Data.Profunctor.Product.Default
import           Data.Profunctor.Product.TH           (makeAdaptorAndInstance)
import           Data.Text                            (Text)
import qualified Data.Text.Encoding                   as TE
import           Data.UUID                            (UUID, fromASCIIBytes,
                                                       toASCIIBytes)
import qualified Data.UUID                            as UUID
import qualified Data.UUID.V4                         as V4
import qualified Database.PostgreSQL.Simple           as PGS
import           Database.PostgreSQL.Simple.FromField (Conversion,
                                                       FromField (..),
                                                       ResultError (..),
                                                       returnError)
import qualified GHC.Generics                         as GHC
import qualified Hasql.Decoders                       as HD
import qualified Hasql.Encoders                       as HE
import           NeatInterpolation
import           Opaleye
import           Opaleye                              (Column, Nullable, PGBool,
                                                       PGDate, PGFloat8, PGInt4,
                                                       PGInt8, PGText, Query,
                                                       QueryArr, Table (Table),
                                                       Unpackspec, aggregate,
                                                       avg, count, groupBy,
                                                       ifThenElse, isNull,
                                                       leftJoin, matchNullable,
                                                       pgString, pgUUID,
                                                       queryTable, required,
                                                       restrict, runQuery,
                                                       showSqlForPostgres, sum,
                                                       (.&&), (.++), (.<),
                                                       (.<=), (.==), (.===))
import           Protolude                            hiding (Generic, optional,
                                                       (&))
import           Servant

import           Types.Domain
import           Types.Domain.Status
import           Utils

--------------------------------------------------------------------------------
type UserTableR = UserPoly
    (Column PGUuid)
    (Column PGInt8)
    (Column PGText)
    (Column PGText)
    (Column PGText)
    (Column PGText)

--------------------------------------------------------------------------------
type UserTableW = UserPoly
    (Column PGUuid)
    (Column PGInt8)
    (Column PGText)
    (Column PGText)
    (Column PGText)
    (Column PGText)

--------------------------------------------------------------------------------
$(makeAdaptorAndInstance "pUser" ''UserPoly)
userTable :: Table UserTableW UserTableR
userTable = Table "users" (pUser
   User {
     userId = (required "id"),
     userVersion = (required "version"),
     userEmail = (required "email"),
     userName = (required "name"),
     userPass = (required "pass"),
     userStatus = (required "status")
   }
 )

instance Default Constant UUID (Maybe (Column PGUuid)) where
  def = Constant ((Just).pgUUID)

--------------------------------------------------------------------------------
userQuery :: Query UserTableR
userQuery = queryTable userTable

--------------------------------------------------------------------------------
selectUserId :: UserId -> Query UserTableR
selectUserId findUserId = proc () -> do
  row <- limit 1 $ (proc () -> do
    row@(User userId _ _ _ _ _) <- userQuery -< ()
    restrict -< userId .== pgUUID findUserId
    returnA -< row) -< ()
  returnA -< row

--------------------------------------------------------------------------------
getUsers :: PGS.Connection -> IO [User]
getUsers conn = do
  runQuery conn $ queryTable userTable

--------------------------------------------------------------------------------
getUserById :: PGS.Connection -> UserId -> IO (Maybe User)
getUserById conn userId = do
  rows <- runQuery conn $ selectUserId userId
  pure $ listToMaybe rows

--------------------------------------------------------------------------------
insertUser :: PGS.Connection -> UserPost -> IO (Maybe User)
insertUser conn payload = do
  newId <- V4.nextRandom
  let version = 1 :: Int64
      user = payload { userId = newId, userVersion = version, userStatus = Active }
  rows <- runInsertManyReturning conn userTable [constant user] (\x -> x) :: IO [User]
  pure $ listToMaybe rows

--------------------------------------------------------------------------------
updateUser :: PGS.Connection -> User -> IO (Maybe User)
updateUser conn payload = do
  rows <- runUpdateReturning
    conn
    userTable
    -- the SET clause, how to update the row
    -- should transform a UserTableR -> UserTableW
    (\row -> row { userVersion = pgInt8 (userVersion payload + 1)
                 , userName = pgStrictText (userName payload)
                 , userStatus = pgStrictText (gToText statusNames (userStatus payload))
                 })
    -- the WHERE clause
    (\row -> userId row .== pgUUID (userId payload))
    -- the RETURNING clause
    (\x -> x) :: IO [User]
  pure $ listToMaybe rows
