WIP: adding servant web server

.gitignore

@@ -3,6 +3,7 @@
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
 /dist-newstyle
+/dsl/dist-newstyle
 .stack-work
 CHANGELOG.md
 test.json

app/Main.hs

@@ -33,6 +33,7 @@ module Main where
   import Data.Text.Encoding (encodeUtf8, decodeUtf8)
   import Data.Text.Lazy (toStrict)
   import Debug.Trace (trace)
+  import ServerMain (serverMain)
   
   ---------------------------------------
 
@@ -45,6 +46,7 @@ module Main where
   main :: IO ()
   main = getArgs >>= process >>= finish where
     process :: [String] -> IO Bool
+    process ["--server"] = serverMain >> return True
     process [path] = printEvents path >> runParser path >> return True
     process args@[_, _] = generateJSON args >> return False
     process args@["--all", src, to] = processDirectory src to >> return False

server/Routes.hs

@@ -0,0 +1,63 @@
+-- SPDX-FileCopyrightText: 2023 David Mosbach <david.mosbach@campus.lmu.de>
+--
+-- SPDX-License-Identifier: AGPL-3.0-or-later
+
+{-# LANGUAGE DataKinds,
+             TypeOperators,
+             FlexibleInstances,
+             MultiParamTypeClasses,
+             OverloadedStrings #-}
+
+module Routes where
+
+import Servant
+import Servant.API
+import Servant.Server
+import Network.HTTP.Media ((//), (/:))
+import Data.ByteString.Lazy.Internal (ByteString)
+
+
+directory :: FilePath
+directory = "." -- Directory of the static files
+
+data HTML
+data HTMLTemplate
+
+type Home = Get '[HTML] [HTMLTemplate]           -- Serve app under /
+       :<|> "app" :> Get '[HTML] [HTMLTemplate]  -- Also serve app under /app
+
+type RequestFile = Raw -- For serving the workflow definitions & index.json | TODO alternatively keep data after parsing & serve as '[JSON]
+
+instance Accept HTML where
+  contentType _ = "text" // "html"
+
+instance MimeRender HTML ByteString where
+  mimeRender _ bs = bs
+
+instance MimeUnrender HTML ByteString where
+  mimeUnrender _ = Right
+
+instance MimeRender HTML [HTMLTemplate] where
+  mimeRender p template = undefined --TODO use encoding function of template library
+
+instance MimeUnrender HTML [HTMLTemplate] where
+  mimeUnrender _ bs = Right undefined -- TODO use decoding function
+
+
+mainServer :: Server Home
+mainServer = undefined
+
+userAPI :: Proxy Home
+userAPI = Proxy
+
+workFlows :: Application
+workFlows = serve userAPI mainServer
+
+fileServer :: Server RequestFile
+fileServer = serveDirectoryFileServer directory
+
+staticAPI :: Proxy RequestFile
+staticAPI = Proxy
+
+files :: Application
+files = serve staticAPI fileServer

server/ServerMain.hs

@@ -0,0 +1,19 @@
+-- SPDX-FileCopyrightText: 2023 David Mosbach <david.mosbach@campus.lmu.de>
+--
+-- SPDX-License-Identifier: AGPL-3.0-or-later
+
+module ServerMain where
+
+import Routes (workFlows, files)
+import Network.Wai
+import Network.Wai.Handler.Warp ( run )
+import Control.Concurrent
+
+serverMain :: IO ()
+serverMain = do
+  putStrLn "Starting app @ http://localhost:8081/"
+  mainServerThread <- forkIO $ run 8081 workFlows
+  putStrLn "Main server is running"
+  putStrLn "Starting file server @ http://localhost:8080/"
+  run 8080 files
+

workflow-visualiser.cabal

@@ -28,7 +28,9 @@ executable workflow-visualiser
     other-modules: Workflow,
                    Export,
                    Index,
-                   YamlParser
+                   YamlParser,
+                   ServerMain,
+                   Routes
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
@@ -41,6 +43,12 @@ executable workflow-visualiser
                       vector,
                       directory,
                       regex-tdfa,
-                      mtl
-    hs-source-dirs:   app
+                      mtl,
+                      servant,
+                      servant-server,
+                      wai,
+                      warp,
+                      http-media,
+                      shakespeare
+    hs-source-dirs:   app, server
     default-language: Haskell2010