Answer.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TupleSections #-}

module HRForms.Data.Answer where

import Prelude hiding (id)


-- import qualified Data.List as List
-- import Data.HashMap.Strict (elems, mapWithKey)
-- import qualified Data.HashMap.Strict as HashMap
import Data.Aeson (FromJSON, ToJSON)
-- import qualified Data.Text
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.ToRow
import Database.PostgreSQL.Simple.SOP
import Database.PostgreSQL.Simple.SqlQQ
import GHC.Generics
import qualified Generics.SOP as SOP

import HRForms.Data.UUID
import HRForms.Data.ID
import HRForms.Data.App
import HRForms.Data.Response
import HRForms.Data.Email
import HRForms.Data.Question (QuestionID)

--------------------------------------------

-- different kinds of responses?
type UserID = ID

data Answer = Answer
  { id :: Maybe ID
  , questionID :: QuestionID
  , sectionID :: UUID
  , categoryID :: UUID
  , formID :: UUID
  , response :: Response
  , email :: EmailAddress
  } deriving (Show, Eq, Generic)

instance FromJSON Answer
instance ToJSON Answer

instance SOP.Generic Answer
instance FromRow Answer where fromRow = gfromRow
instance ToRow Answer   where toRow   = gtoRow

findByForm :: EmailAddress -> UUID -> App [Answer]
findByForm (EmailAddress em) fid = do
    rows <- query "SELECT * FROM answers WHERE email = ? AND form_id = ? ORDER BY id ASC " (em, fid) :: App [Answer]
    return rows


saveAll :: [Answer] -> App ()
saveAll = mapM_ save

-- UPSERT-ish compatible with Postgres 9.1 or higher. 
-- 9.5 adds upserts, but it's unlikely we're running it.
-- http://stackoverflow.com/questions/1109061/insert-on-duplicate-update-in-postgresql/30118648#30118648
-- http://stackoverflow.com/questions/1109061/insert-on-duplicate-update-in-postgresql/30118648#answer-8702291
save :: Answer -> App ()
save a = do
  execute_ [sql|
    INSERT INTO answers (question_id, section_id, category_id, form_id, response, email) VALUES (?,?,?,?,?,?)
    ON CONFLICT (question_id, email) DO UPDATE SET response = ?
  |] (questionID a, sectionID a, categoryID a, formID a, response a, email a, response a)

  return ()