From 1a2dece599a4e70e61cbbd2106d58847c41c7a10 Mon Sep 17 00:00:00 2001 From: Alan Davidson Date: Sun, 21 Dec 2025 00:37:32 -0500 Subject: [PATCH 1/4] add explanatory comment --- src/EDSL.hs | 4 ++++ 1 file changed, 4 insertions(+) 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 From ba19a2bf2b8f09aa6ee587913b8136eaaadb0ef8 Mon Sep 17 00:00:00 2001 From: Alan Davidson Date: Sun, 21 Dec 2025 00:43:26 -0500 Subject: [PATCH 2/4] change package.yaml Spock->scotty --- package.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From db067bb210dc9dcb91b5620cd0fe703168684cbf Mon Sep 17 00:00:00 2001 From: Alan Davidson Date: Sun, 21 Dec 2025 01:20:35 -0500 Subject: [PATCH 3/4] stopping for the evening: doesn't compile, but all remaining problems are in 'app' --- server/Main.hs | 39 +++++++++++++++++++++++---------------- 1 file changed, 23 insertions(+), 16 deletions(-) diff --git a/server/Main.hs b/server/Main.hs index f69f717d..201c66a6 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) @@ -32,8 +40,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 +53,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 From 02da1617d6affe4a7a7ac9418ae5a51370447b2d Mon Sep 17 00:00:00 2001 From: Alan Davidson Date: Sun, 21 Dec 2025 01:46:57 -0500 Subject: [PATCH 4/4] remove unused type: we don't have Sessions --- server/Main.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/server/Main.hs b/server/Main.hs index 201c66a6..0c87cf9c 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -31,7 +31,6 @@ import TopicRegistry(topicNames, findCachers, TopicRegistry, makeTopicRegistry) import ThreadPool(newThreadPool) -data MySession = EmptySession data MyAppState = IOState (IORef StdGen) TopicRegistry