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

module Lib where

import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Database.Persist.TH (mkMigrate, mkPersist, persistLowerCase, share, sqlSettings)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader, ReaderT,  asks)
import Control.Monad.Trans.Class (MonadTrans, lift)
import qualified Database.Persist as DB
import qualified Database.Persist.Postgresql as DB
import Web.ClientSession
import Web.Scotty.Trans
import qualified Data.Text.Lazy as LT

data Config = Config
              { environment :: Environment
              , pool :: DB.ConnectionPool
              , key :: Key
              }

type Error = LT.Text
type Action = ActionT Error ConfigM ()


data Environment =
      Development |
      Production |
      Test
      deriving (Eq, Read, Show)

newtype ConfigM a =
  ConfigM { runConfigM :: ReaderT Config IO a }
  deriving (Applicative, Functor, Monad, MonadIO, MonadReader Config)


runDB :: (MonadTrans t, MonadIO (t ConfigM)) =>
         DB.SqlPersistT IO a -> t ConfigM a
runDB q = do
  p <- lift (asks pool)
  liftIO (DB.runSqlPool q p)

type UserID = Int

share [mkMigrate "migrateAll", mkPersist sqlSettings] [persistLowerCase|
Lift json
  weight Int
  content Text
  created UTCTime default=now()
  userId Int
  deriving Show
User json
  name Text
  token Text
  Username name
  AuthToken token
  deriving Show
|]
