Types.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

module Types where

import GHC.Generics
import Web.HttpApiData
import Data.Aeson
import Data.Text (Text)
import Database.Beam
import Database.Beam.Sqlite
import Database.Beam.Backend.SQL
import Database.Beam.Backend.Types
import Database.SQLite.Simple.FromField

data ScoreboardDb f
    = ScoreboardDb
    { _sdbUsers          :: f (TableEntity UserT)
    , _sdbTestSets       :: f (TableEntity TestSetT)
    , _sdbDocuments      :: f (TableEntity DocumentT)
    , _sdbQueries        :: f (TableEntity QueryT)
    , _sdbAssessmentSets :: f (TableEntity AssessmentSetT)
    , _sdbAssessments    :: f (TableEntity AssessmentT)
    }
    deriving (Generic)

instance Database be ScoreboardDb

----------------------------------------------------------------------
-- User
----------------------------------------------------------------------

data UserT f
    = User
    { _userId   :: Columnar f Int
    , _userName :: Columnar f Text
    }
    deriving (Generic)

type User = UserT Identity
type UserId = PrimaryKey UserT Identity
deriving instance Show (PrimaryKey UserT Identity)
deriving instance Show User

instance Table UserT where
    data PrimaryKey UserT f = UserId (Columnar f Int) deriving Generic
    primaryKey = UserId . _userId

instance Beamable UserT
instance Beamable (PrimaryKey UserT)


----------------------------------------------------------------------
-- TestSet
----------------------------------------------------------------------

newtype TestSetName = TestSetName Text
                    deriving (Show, Eq, Ord, FromJSON, ToJSON, FromHttpApiData, ToHttpApiData)

data TestSetT f
    = TestSet
    { _testsetId          :: Columnar f Int
    , _testsetName        :: Columnar f TestSetName
    , _testsetDescription :: Columnar f Text
    }
    deriving (Generic)

type TestSet = TestSetT Identity
type TestSetId = PrimaryKey TestSetT Identity
deriving instance Show (PrimaryKey TestSetT Identity)
deriving instance Show TestSet

instance Table TestSetT where
    data PrimaryKey TestSetT f = TestSetId (Columnar f Int) deriving Generic
    primaryKey = TestSetId . _testsetId

instance Beamable TestSetT
instance Beamable (PrimaryKey TestSetT)


----------------------------------------------------------------------
-- Document
----------------------------------------------------------------------

newtype DocumentName = DocumentName Text
                    deriving (Show, Eq, Ord, FromJSON, ToJSON, FromHttpApiData, ToHttpApiData)

deriving instance HasSqlValueSyntax be Text => HasSqlValueSyntax be DocumentName
deriving instance FromField DocumentName
instance FromBackendRow Sqlite DocumentName

data DocumentT f
    = Document
    { _documentId      :: Columnar f Int
    , _documentName    :: Columnar f DocumentName
    , _documentTestSet :: PrimaryKey TestSetT f
    }
    deriving (Generic)

type Document = DocumentT Identity
type DocumentId = PrimaryKey DocumentT Identity
deriving instance Show (PrimaryKey DocumentT Identity)
deriving instance Show Document

instance Table DocumentT where
    data PrimaryKey DocumentT f = DocumentId (Columnar f Int) deriving Generic
    primaryKey = DocumentId . _documentId

instance Beamable DocumentT
instance Beamable (PrimaryKey DocumentT)


----------------------------------------------------------------------
-- Query
----------------------------------------------------------------------

data QueryT f
    = Query
    { _queryId      :: Columnar f Int
    , _queryTestSet :: PrimaryKey TestSetT f
    , _queryName    :: Columnar f Text
    }
    deriving (Generic)

type Query = QueryT Identity
type QueryId = PrimaryKey QueryT Identity
deriving instance Show (PrimaryKey QueryT Identity)
deriving instance Show Query

instance Table QueryT where
    data PrimaryKey QueryT f = QueryId (Columnar f Int) deriving Generic
    primaryKey = QueryId . _queryId

instance Beamable QueryT
instance Beamable (PrimaryKey QueryT)


----------------------------------------------------------------------
-- AssessmentSet
----------------------------------------------------------------------

data AssessmentSetT f
    = AssessmentSet
    { _asetId      :: Columnar f Int
    , _asetTestSet :: PrimaryKey TestSetT f
    }
    deriving (Generic)

type AssessmentSet = AssessmentSetT Identity
type AssessmentSetId = PrimaryKey AssessmentSetT Identity
deriving instance Show (PrimaryKey AssessmentSetT Identity)
deriving instance Show AssessmentSet

instance Table AssessmentSetT where
    data PrimaryKey AssessmentSetT f = AssessmentSetId (Columnar f Int) deriving Generic
    primaryKey = AssessmentSetId . _asetId

instance Beamable AssessmentSetT
instance Beamable (PrimaryKey AssessmentSetT)


----------------------------------------------------------------------
-- Assessment
----------------------------------------------------------------------

data AssessmentT f
    = Assessment
    { _assessmentId   :: Columnar f Int
    , _assessmentSet   :: PrimaryKey AssessmentSetT f
    , _assessmentQuery :: PrimaryKey QueryT f
    , _assessmentDoc   :: PrimaryKey DocumentT f
    , _assessmentRel   :: Columnar f Int
    }
    deriving (Generic)

type Assessment = AssessmentT Identity
type AssessmentId = PrimaryKey AssessmentT Identity
deriving instance Show (PrimaryKey AssessmentT Identity)
deriving instance Show Assessment

instance Table AssessmentT where
    data PrimaryKey AssessmentT f = AssessmentId (Columnar f Int) deriving Generic
    primaryKey = AssessmentId . _assessmentId

instance Beamable AssessmentT
instance Beamable (PrimaryKey AssessmentT)

----------------------------------------------------------------------
-- Run
----------------------------------------------------------------------

data RunT f
    = Run
    { _runId        :: Columnar f Int
    , _runTestSet :: PrimaryKey TestSetT f
    , _runSubmitter :: PrimaryKey UserT f
    }
    deriving (Generic)

type Run = RunT Identity
type RunId = PrimaryKey RunT Identity
deriving instance Show (PrimaryKey RunT Identity)
deriving instance Show Run

instance Table RunT where
    data PrimaryKey RunT f = RunId (Columnar f Int) deriving Generic
    primaryKey = RunId . _runId

instance Beamable RunT
instance Beamable (PrimaryKey RunT)


----------------------------------------------------------------------
-- RunResult
----------------------------------------------------------------------

data RunResultT f
    = RunResult
    { _runResultId :: Columnar f Int
    , _runQuery    :: PrimaryKey QueryT f
    , _runDocument :: PrimaryKey DocumentT f
    , _runScore    :: Columnar f Double
    }
    deriving (Generic)

type RunResult = RunResultT Identity
type RunResultId = PrimaryKey RunResultT Identity
deriving instance Show (PrimaryKey RunResultT Identity)
deriving instance Show RunResult

instance Table RunResultT where
    data PrimaryKey RunResultT f = RunResultId (Columnar f Int) deriving Generic
    primaryKey = RunResultId . _runResultId

instance Beamable RunResultT
instance Beamable (PrimaryKey RunResultT)