Scotty -> Twain

dtekcth · Sep 26, 2023 · 0f17db0 · 0f17db0
1 parent 203c1bb
commit 0f17db0
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 14 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -31,6 +31,7 @@ import           Lens.Micro.Platform                      ( (<&>)
                                                           , view
                                                           )
 import           Network.HTTP.Client.TLS                  ( newTlsManager )
+import           Network.Wai.Handler.Warp                 ( run )
 import           Network.Wai.Middleware.RequestLogger     ( logStdout )
 import           Network.Wai.Middleware.StaticEmbedded    ( static )
 import           System.Console.GetOpt                    ( ArgDescr(..)
@@ -41,12 +42,8 @@ import           System.Console.GetOpt                    ( ArgDescr(..)
                                                           )
 import           System.Environment                       ( getArgs )
 import           System.IO                                ( stdout )
-import           Web.Scotty                               ( get
-                                                          , html
-                                                          , middleware
-                                                          , redirect
-                                                          , scotty
-                                                          )
+import           Data.Text.Lazy.Encoding                  ( encodeUtf8 )
+import           Web.Twain
 
 import           Config
 import           Model
@@ -86,7 +83,7 @@ main =
                     -- timer
                     (forever $ tryPutMVar upd () >> threadDelay (view cInterval config))
                     -- webserver
-                    (serve config viewRef upd))
+                    (webserver config viewRef upd))
                   -- updater
                   (forever
                     $ withFDHandler defaultBatchingOptions stdout 1.0 80
@@ -102,14 +99,29 @@ main =
                                         ))
   where usage = putStrLn $ usageInfo "mat-chalmers [OPTION...]" opts
 
-serve
+webserver
   :: Config
   -> IORef View -- ^ View model
   -> MVar () -- ^ Update signal
   -> IO ()
-serve conf viewRef upd = scotty (view cPort conf) $ do
-  middleware logStdout
-  middleware (static $(embedDir "static"))
-  get "/"  ((html . render) =<< liftIO (readIORef viewRef))
-  get "/r" (liftIO (tryPutMVar upd ()) >> redirect "/") -- force update
+webserver Config{_cPort=webserverPort} viewRef upd =
+  run webserverPort $ foldr ($) (notFound missing)
+    [ middleware . get "/"  index
+    , middleware . get "/r" forceUpdate
+    ]
+ where
+   index :: ResponderM a
+   index = do
+     theCurrentView <- liftIO (readIORef viewRef)
+     (send . html . encodeUtf8 . render) theCurrentView
+
+   forceUpdate :: ResponderM a
+   forceUpdate = do
+     _ <- liftIO $ tryPutMVar upd ()
+     send   $ redirect302 "/"
+
+   missing :: ResponderM a
+   missing = send $ html "Not found..."
+
+   middleware = logStdout . static $(embedDir "static")
 
diff --git a/mat-chalmers.cabal b/mat-chalmers.cabal
@@ -65,11 +65,13 @@ executable mat-chalmers
                , microlens-platform
                , logging-effect
                , mtl
-               , scotty >= 0.12.1 && < 0.13
                , time >= 1.12 && < 1.13
+               , twain >= 2.1.2.0 && < 3.0
                , wai-extra >= 3.1.13.0 && < 4.0
                , wai-middleware-static-embedded == 0.1.0.0
                , async >= 2.2.4 && <= 3.0
+               , warp >= 3.3.29 && < 4.0
+               , text
   default-language: Haskell2010
 
 Test-Suite test-mat