{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RecordWildCards #-} module Main where import Control.Monad import Control.Monad.Random import Data.Aeson import qualified Data.ByteString as B hiding (pack, unpack) import qualified Data.ByteString.Char8 as B (pack, unpack) import Data.Char import Data.Maybe import Data.Pool import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Time import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.FromRow import Database.PostgreSQL.Simple.SqlQQ import Database.PostgreSQL.Simple.Types import System.Environment import Yesod.Core import Yesod.Core.Json import Yesod.Core.Content import Paths_fluffy import Yesod.Static -- Site data Fluffy = Fluffy { fluffyConnectionPool :: Pool Connection , fluffyStatic :: Static } -- True or False data TrueOrFalse = TrueOrFalse { tofId :: Int , tofBody :: T.Text , tofAnswer :: Bool , tofRationale :: Maybe T.Text , tofDifficulty :: Maybe T.Text , tofReference :: Maybe Int , tofLearningObjectives :: Maybe T.Text , tofNationalStandards :: Maybe T.Text , tofTopics :: Maybe T.Text , tofKeyWords :: [T.Text] } deriving (Show,Eq) -- Gap filling data GapFilling = GapFilling { gfId :: Int , gfBody :: T.Text , gfAnswer :: T.Text , gfDifficulty :: Maybe T.Text , gfReference :: Maybe Int , gfLearningObjectives :: Maybe T.Text , gfNationalStandards :: Maybe T.Text , gfTopics :: Maybe T.Text , gfKeyWords :: [T.Text] } deriving (Show,Eq) -- Multiple Choice data MultipleChoice = MultipleChoice { mcId :: Int , mcBody :: T.Text , mcAnswer :: Int , mcChoices :: [T.Text] } deriving (Show,Eq) instance FromRow TrueOrFalse where fromRow = TrueOrFalse <$> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field <*> (fromPGArray <$> field) instance FromRow GapFilling where fromRow = GapFilling <$> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field <*> (fromPGArray <$> field) instance FromRow MultipleChoice where fromRow = MultipleChoice <$> field <*> field <*> field <*> (fromPGArray <$> field) mkYesod "Fluffy" [parseRoutes| / HomeR GET /true-or-false/#Int TrueOrFalseR GET /gap-filling/#Int GapFillingR GET /multiple-choice/#Int MultipleChoiceR GET /static StaticR Static fluffyStatic /.clean-history CleanHistory GET |] instance Yesod Fluffy where makeSessionBackend site = pure <$> defaultClientSessionBackend (7 * 24 * 60) "client_session_key.aes" defaultLayout widget = do pc <- widgetToPageContent widget withUrlRenderer [hamlet| $doctype 5