{-# LANGUAGE GADTs, TypeFamilies, TemplateHaskell, QuasiQuotes, FlexibleInstances, DeriveGeneric, StandaloneDeriving, CPP #-}


module Repository

    (Person, Account, validateUser, insertEntity)

where

import Database.Groundhog.Core
import Database.Groundhog.Generic
import Database.Groundhog.Postgresql
import Database.Groundhog.TH
import Database.Groundhog (select)
import Control.Monad.Reader
import Data.Pool
import GHC.Generics
import Data.UUID (UUID, fromText, toText)
import Data.UUID.V4
import Data.Time.Calendar
import Crypto.Hash.MD5
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (pack, unpack)
import Data.ByteString.Base64 (encode)
import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON, toEncoding, withText, Object)
import Web.PathPieces (PathPiece, fromPathPiece, toPathPiece)
import Data.Maybe (fromMaybe)
import Control.Lens

instance PathPiece UUID where
    fromPathPiece = fromText
    toPathPiece = toText

#if MIN_VERSION_aeson(1,1,1)

#else

instance FromJSON UUID where
    parseJSON = withText "UUID" $
        maybe (fail "Invalid UUID") pure . fromText

instance ToJSON UUID where
    toJSON = toJSON . toText

#endif

instance PrimitivePersistField UUID where
  toPrimitivePersistValue uuid = toPrimitivePersistValue $ show uuid
  fromPrimitivePersistValue a = uuid where
    uuid = read $ fromPrimitivePersistValue a

instance PersistField UUID where
  persistName _ = "UUID"
  toPersistValues = primToPersistValue
  fromPersistValues = primFromPersistValue
  dbType _ _ = DbTypePrimitive (DbOther $ OtherTypeDef [Left "uuid"]) False Nothing Nothing

-- These two instances of superclasses are useful but not necessary. They are like Functor and Applicative instances when you implement a Monad.
instance SinglePersistField UUID where
  toSinglePersistValue = primToSinglePersistValue
  fromSinglePersistValue = primFromSinglePersistValue

instance PurePersistField UUID where
  toPurePersistValues = primToPurePersistValues
  fromPurePersistValues = primFromPurePersistValues


data Person = Person {
    personId :: UUID,
    firstName :: String,
    lastName  :: String,
    phoneNumber :: String,
    mobileNumber :: String,
    mobileNumber2 :: String,
    birthDate :: Day,
--     image :: ByteString,
    nationalCode :: String,
    postalCode :: String,
    address :: String
    } deriving (Show, Generic)


data Account  = Account {
    accountId :: UUID,
    cityId :: Maybe Int,
    userTypeId :: Maybe Int,
    userName :: String,
    password :: String,
    email :: Maybe String,
    pushToken :: Maybe String,
    active :: Maybe Bool,
    registerDate :: Maybe Day,
    verificationCode :: Maybe String,
    verified :: Bool,
    referrerId :: UUID,
    person :: DefaultKey Person
    } deriving Generic

deriving instance Show Account


data Vehicle = Vehicle {
    vehicleId :: UUID,
    vehicleCapacity :: Int,
    vehicleModel :: String,
    plateNumber :: String,
    imei :: String,
    rate :: Double,
    imei2 :: String,
    workHours :: String,
--     bankAccountInfo :: Object,
    appVersion :: Int,
    account :: DefaultKey Account

}


deriving instance Show Vehicle

instance FromJSON Person
instance ToJSON Person


mkPersist defaultCodegenConfig {namingStyle=persistentNamingStyle {mkDbEntityName = toUnderscore, mkDbFieldName = \_ _ _ dbName _-> toUnderscore dbName}} [groundhog|
definitions:
  - entity: Person
    autoKey: null

    constructors:
      - name: Person
        uniques:
          - name: PersonIdPK
            type: primary
            fields: [personId]
        fields:
          - name: firstName
            type: varchar(100)
          - name: lastName
            type: varchar(100)
          - name: phoneNumber
            type: varchar(15)
          - name: mobileNumber
            type: varchar(15)
          - name: mobileNumber2
            type: varchar(15)
          - name: birthDate
            type: date
#          - name: image
#            type: bytea
          - name: nationalCode
            type: varchar(10)
          - name: postalCode
            type: varchar(10)
          - name: address
            type: varchar(250)


  - entity: Account
    autoKey: null

    constructors:
      - name: Account
        uniques:
          - name: AccountIdPK
            type: primary
            fields: [accountId]
        fields:
          - name: cityId
            type: int
          - name: userTypeId
            type: int
          - name: userName
            type: varchar(50)
          - name: password
            type: varchar(50)
          - name: email
            type: varchar(50)
          - name: pushToken
            type: varchar(50)
          - name: active
            type: boolean
          - name: registerDate
            type: date
          - name: verificationCode
            type: varchar(10)
          - name: verified
            type: boolean
          - name: referrerId
            type: uuid



  - entity: Vehicle
    autoKey: null

    constructors:
      - name: Vehicle
        uniques:
            - name: VehicleIdPk
              type: primary
              fields: [vehicleId]

        fields:
            - name: vehicleCapacity
              type: smallint
            - name: vehicleModel
              type: varchar(100)
            - name: plateNumber
              type: varchar(20)
            - name: imei
              type: varchar(20)
            - name: rate
              type: decimal
            - name: imei2
              type: varchar(20)
            - name: workHours
              type: varchar(100)
#            - name: bankAccountInfo
#              type: json
            - name: appVersion
              type: int






|]

validateUser :: Pool Postgresql -> String -> String -> IO Bool

validateUser pool username password = do
    x <- flip runDbConn pool $ select (AccountUserName ==. username &&. AccountPassword ==. unpack (encode $ hash (pack password)))
    return $ null x



insertEntity ::  (PersistEntity val) => Pool Postgresql -> val -> IO (AutoKey val)

insertEntity pool e = flip runDbConn pool $ insert e



addVehicle :: Pool Postgresql -> Vehicle -> IO (AutoKey Vehicle)

addVehicle pool v = do
    pid <- nextRandom
    aid <- nextRandom

    let v = v {account = (account v) {accountId = aid} }
    let v = v & account.accountId .~ aid