diff --git a/package.yaml b/package.yaml index 10c7bfd8..afe8ec8d 100644 --- a/package.yaml +++ b/package.yaml @@ -48,7 +48,7 @@ executables: - concurrency - ghc - mtl - - Spock + - scotty - text - time - wai diff --git a/server/Main.hs b/server/Main.hs index f69f717d..0c87cf9c 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -2,19 +2,27 @@ module Main where import Control.Monad.Trans(liftIO) -import Control.Monad.Trans.State.Strict(runStateT) +import Control.Monad.Trans.Class(lift) +import Control.Monad.Trans.State.Strict(runStateT, evalStateT, StateT) +-- We need to distinguish State.get from Scotty.get +import qualified Control.Monad.Trans.State.Strict as State import Data.IORef(IORef, newIORef, readIORef, writeIORef) -import Data.Text(pack, toLower, isInfixOf) -import Data.Text.Encoding(decodeUtf8) +import Data.Text.Lazy(pack, toLower, isInfixOf) +import Data.Text.Lazy.Encoding(decodeUtf8) import Data.Time(getCurrentTime) import Network.Wai(Request, requestHeaders) -- Take the `Dev` off the end to get more standardized server logs. import Network.Wai.Middleware.RequestLogger(logStdoutDev) import Network.Wai.Middleware.Static(staticPolicy, addBase) import System.Random(StdGen, getStdGen) -import Web.Spock(SpockM, file, text, get, post, root, spock, runSpock, json, - getState, middleware, param, request) -import Web.Spock.Config(PoolOrConn(PCNoDatabase), defaultSpockCfg) + +import Web.Scotty(ScottyM, file, text, get, post, scotty, json, + middleware, param, request) + + +--import Web.Spock(SpockM, file, text, get, post, root, spock, runSpock, json, +-- getState, middleware, param, request) +--import Web.Spock.Config(PoolOrConn(PCNoDatabase), defaultSpockCfg) import Random(pickItem) @@ -23,7 +31,6 @@ import TopicRegistry(topicNames, findCachers, TopicRegistry, makeTopicRegistry) import ThreadPool(newThreadPool) -data MySession = EmptySession data MyAppState = IOState (IORef StdGen) TopicRegistry @@ -32,8 +39,7 @@ main = do (pool, rng) <- getStdGen >>= runStateT (newThreadPool 4) registry <- makeTopicRegistry pool ref <- newIORef rng - spockCfg <- defaultSpockCfg EmptySession PCNoDatabase (IOState ref registry) - runSpock 8765 (spock spockCfg app) + scotty 8765 . evalStateT app $ IOState ref registry isMobile :: Request -> Bool @@ -46,22 +52,22 @@ isMobile req = let maybe False isMobileAgent maybeUseragent -app :: SpockM () MySession MyAppState () +app :: StateT MyAppState ScottyM () app = do - middleware logStdoutDev + lift $ middleware logStdoutDev -- NOTE: these next two are relative to the current working directory when -- you execute the program! So, you need to run it from the right place. - middleware (staticPolicy (addBase "static")) - get root $ do + lift $ middleware (staticPolicy (addBase "static")) + lift $ get "/" $ do req <- request file "text/html" $ if isMobile req then "static/mobile.html" else "static/index.html" - post "bugreport" $ text . pack $ "bug report received!\n" - get "topics" $ json topicNames - get "situation" $ do + lift $ post "/bugreport" $ text . pack $ "bug report received!\n" + lift $ get "/topics" $ json topicNames + lift $ get "/situation" $ do liftIO $ getCurrentTime >>= print requested <- param "topics" - (IOState ioRng registry) <- getState + (IOState ioRng registry) <- State.get let malformed = Left "no topics selected" case maybe malformed (findCachers registry) requested of Left err -> text . pack $ err diff --git a/src/EDSL.hs b/src/EDSL.hs index 28b050a0..d5e2c483 100644 --- a/src/EDSL.hs +++ b/src/EDSL.hs @@ -99,6 +99,10 @@ makeAlertableCall call alert = makeCompleteCall_ completeCall makePass :: Action makePass = makeCall T.Pass +-- This keeps the last call of the given action, but throws away all the +-- definitions and constraints added from it. Should be used very rarely: it was +-- created to practice pretending to have the queen of trump when you've got a +-- 10-card fit and partner asks for keycards. stealCall :: Action -> Action stealCall = makeCompleteCall_ . extractLastCall