{-# Language GADTs, GeneralizedNewtypeDeriving, OverloadedStrings, QuasiQuotes, TemplateHaskell, TypeFamilies #-}

module UniWorX (User(..), initDB, testUsers) where

import User

import Control.Applicative ((<|>))
import Control.Monad (void, forM_)

import Database.Persist
import Database.Persist.TH
import Database.Persist.Postgresql

import System.Environment (lookupEnv)


share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
  User
    name Text
    email Text
    deriving Eq Show
|]

testUsers :: [User] -- TODO move to db
testUsers =
  [ User {name = "Fallback User", email = "foo@bar.com"}
  , User {name = "Tina Tester", email = "t@t.tt"}
  , User {name = "Max Muster", email = "m@m.mm"}]

runDB :: IO a -> IO a
runDB action = do
  Just port <- lookupEnv "OAUTH2_DB_PORT" <|> Just "9444"
  let connStr = "host=localhost dbname=test_users user=oauth2mock password=0000 port=" ++ port
  withPostgresqlPool connStr 10 $ \pool -> flip runSqlPersistMPool pool action

initDB :: IO ()
initDB = runDB $ do
  runMigration migrateAll
  forM_ testUsers $ void . insert

instance UserData User (Map Text Text) where
  data Scope User = ID | Profile deriving (Show, Read, Eq)
  readScope = read
  showScope = show
  userScope (Entity uID _) ID = singleton "id" uID
  userScope (Entity _ User{..}) Profile = fromList [("name", name), ("email", email)]
  lookupUser email _ = runDB $ do
    user <- selectList [UserEmail ==. e] []
    case user of
      [Entity _ u] -> return $ Just u
      [] -> Nothing
      _ -> error "Ambiguous User."