module Core where

import Control.Exception                    (IOException)
import Control.Monad.Catch                  (catch)
import Data.Aeson                           (FromJSON, ToJSON)
import Data.Pool                            (Pool)
import qualified Data.Text                  as T
import Database.PostgreSQL.Simple           (Connection, Query)
import Database.PostgreSQL.Simple.FromField (FromField)
import Database.PostgreSQL.Simple.FromRow   (FromRow, field, fromRow)
import Database.PostgreSQL.Simple.ToField   (ToField, toField)
import Database.PostgreSQL.Simple.ToRow     (ToRow, toRow)
import Effectful
import Effectful.Error.Static               (Error, throwError)
import Effectful.Reader.Static              (Reader)
import GHC.Generics                         (Generic)
import Servant hiding                       ((:>), throwError)

--
-- Core data types
--
type AppEff = 
  Eff '[ Logger
       , Database
       , Reader AppEnv
       , Error ServerError
       , IOE
       ]

data AppEnv = AppEnv { pool :: Pool Connection }

newtype UserId = UserId Int
  deriving (Show, Generic, FromField, ToField, FromHttpApiData, ToHttpApiData)

instance ToJSON UserId
instance FromJSON UserId
instance ToRow UserId
instance FromRow UserId

data User = User { userId :: UserId, userName :: T.Text}
  deriving (Show, Generic)

instance FromRow User where
    fromRow = User <$> field <*> field
instance ToRow User where
    toRow (User uid name) = toRow (uid, name)

instance ToJSON User
instance FromJSON User

data Database :: Effect where
  DatabaseInit
    :: Database (Eff es) ()
  DatabaseRead
    :: (ToField a, Show a, FromRow b) => (Query, a) -> Database (Eff es) [b]
  DatabaseRead_
    :: (FromRow b) => Query -> Database (Eff es) [b]
  DatabaseWrite
    :: (ToRow a, Show a) => (Query, a) -> Database (Eff es) ()

data Logger :: Effect where
    WriteLog :: LogLevel -> String -> Logger (Eff es) ()

data LogLevel = Info | Warning | Error
  deriving (Show, Eq)

instance ToField LogLevel where
  toField level = toField (T.pack (show level))

-- Utility
liftIOE :: (IOE :> es, Error ServerError :> es) => IO a -> Eff es a
-- Lift IO into Eff and catch IOExceptions
liftIOE m = liftIO m `catch` \(e::IOException) -> do
    -- Log IOExceptions to stdout
    liftIO $ putStrLn $ "ERROR Exception: " ++ show e
    -- Throw a custom Servant ServerError
    throwError $ ServerError
      { errHTTPCode     = 500
      , errReasonPhrase = "Internal Server Error"
      , errBody         = "This incident will be investigated."
      , errHeaders      = []
      }