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

module Model where

import GHC.Generics
import Database.Persist
import Database.Persist.Sql
import Database.Persist.TH
import Data.Text (Text(..))
import Data.Aeson

import PasteType

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
User json
    username Text
    password Text
    Username username
    deriving Show Generic Eq

Paste json
    poster UserId
    name Text
    content Text
    type PasteType
    PasteNamePoster name poster
    deriving Show Generic Eq
|]

data SanitizedPaste = SanitizedPaste
    { name :: Text
    , content :: Text
    , type_ :: PasteType
    } deriving (Show, Generic, Eq)

-- Make the API slightly nicer by not having an ugly underscore on type_
instance ToJSON SanitizedPaste where
    toJSON (SanitizedPaste name content type_) = object ["name" .= name, "content" .= content, "type" .= type_]

instance FromJSON SanitizedPaste where
    parseJSON = withObject "SanitizedPaste" $ \v -> SanitizedPaste
        <$> v .: "name"
        <*> v .: "content"
        <*> v .: "type"

sanitizePaste :: Paste -> SanitizedPaste
sanitizePaste Paste{..} = SanitizedPaste
    { name = pasteName
    , content = pasteContent
    , type_ = pasteType
    }

attachPoster :: Key User -> SanitizedPaste -> Paste
attachPoster uid SanitizedPaste{..} = Paste
    { pasteName = name
    , pasteContent = content
    , pasteType = type_
    , pastePoster = uid
    }

doMigrations :: SqlPersistT IO ()
doMigrations = runMigration migrateAll