{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

module Model.Database where

import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
import Control.Monad.Trans.Resource (runResourceT, ResourceT)

import Data.Text
import Data.Time.Clock (UTCTime)
import Data.Time.Calendar (Day)
import Data.Int (Int64)

import Database.Persist.Sqlite
import Database.Persist.TH

import Resource (Resource, createdAt, editedAt, deletedAt)

import Model.Frequency

import Job.Kind

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
User
  creation UTCTime
  email Text
  name Text
  UniqUserEmail email
  UniqUserName name
  deriving Show
Payment
  userId UserId
  name Text
  cost Int
  date Day
  frequency Frequency
  createdAt UTCTime
  editedAt UTCTime Maybe
  deletedAt UTCTime Maybe
  deriving Show
SignIn
  token Text
  creation UTCTime
  email Text
  isUsed Bool
  UniqSignInToken token
  deriving Show
Job
  kind Kind
  lastExecution UTCTime Maybe
  lastCheck UTCTime Maybe
  UniqJobName kind
  deriving Show
Income
  userId UserId
  date Day
  amount Int
  createdAt UTCTime
  editedAt UTCTime Maybe
  deletedAt UTCTime Maybe
  deriving Show
|]

instance Resource Payment where
  createdAt = paymentCreatedAt
  editedAt = paymentEditedAt
  deletedAt = paymentDeletedAt

instance Resource Income where
  createdAt = incomeCreatedAt
  editedAt = incomeEditedAt
  deletedAt = incomeDeletedAt

type Persist a = SqlPersistT (ResourceT (NoLoggingT IO)) a

runDb :: Persist a -> IO a
runDb = runNoLoggingT . runResourceT . withSqliteConn "database" . runSqlConn

runMigrations :: IO ()
runMigrations = runDb $ runMigration migrateAll

textToKey :: (ToBackendKey SqlBackend a) => Text -> Key a
textToKey text = toSqlKey (read (unpack text) :: Int64)

keyToInt64 :: (ToBackendKey SqlBackend a) => Key a -> Int64
keyToInt64 = fromSqlKey