module Ideas.Encoding.Options
( Options, makeOptions, optionBaseUrl
, script, request, qcGen, baseUrl, maxTime, logRef
, cgiBin, optionCgiBin, optionHtml
) where
import Control.Applicative
import Data.Maybe
import Data.Semigroup as Sem
import Ideas.Encoding.Logging (LogRef)
import Ideas.Encoding.Request
import Ideas.Service.DomainReasoner
import Ideas.Service.FeedbackScript.Parser (parseScriptSafe, Script)
import Test.QuickCheck.Random
cgiBin :: Options -> Maybe String
cgiBin = cgiBinary . request
optionCgiBin :: String -> Options -> Options
optionCgiBin s options = options {request = (request options) {cgiBinary = Just s}}
data Options = Options
{ request :: Request
, qcGen :: Maybe QCGen
, script :: Script
, baseUrl :: Maybe String
, maxTime :: Maybe Int
, logRef :: LogRef
}
instance Sem.Semigroup Options where
x <> y = Options
{ request = request x <> request y
, qcGen = make qcGen
, script = script x <> script y
, baseUrl = make baseUrl
, maxTime = make maxTime
, logRef = logRef x <> logRef y
}
where
make f = f x <|> f y
instance Monoid Options where
mempty = Options mempty Nothing mempty Nothing Nothing mempty
mappend = (<>)
optionHtml :: Options -> Options
optionHtml options = options
{ request = (request options) {encoding = [EncHTML]} }
optionBaseUrl :: String -> Options -> Options
optionBaseUrl base options = options {baseUrl = Just base}
makeOptions :: DomainReasoner -> Request -> IO Options
makeOptions dr req = do
gen <- maybe newQCGen (return . mkQCGen) (randomSeed req)
scr <- case feedbackScript req of
Just s -> parseScriptSafe s
Nothing -> defaultScript dr (fromMaybe mempty (exerciseId req))
return $ mempty
{ request = req
, qcGen = Just gen
, script = scr
}