lmu/uni2work.workflows.visualiser
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

unified both servers

Browse Source
This commit is contained in:
David Mosbach 2023-09-05 01:59:03 +02:00
parent c67538305d
commit acf3a4de83
3 changed files with 49 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
server/Routes.hs
View File

@ -15,18 +15,22 @@ import Servant.API
import Servant.Server import Servant.Server
import Network.HTTP.Media ((//), (/:)) import Network.HTTP.Media ((//), (/:))
import Data.ByteString.Lazy.Internal (ByteString) import Data.ByteString.Lazy.Internal (ByteString)
import Control.Monad.Cont (liftIO)
import qualified Data.ByteString.Lazy.UTF8 as BSL.U
directory :: FilePath directory :: FilePath
directory = "." -- Directory of the static files directory = "." -- Directory of the static files
data HTML data HTML
data HTMLTemplate newtype HTMLTemplate = HTMLTemp ByteString
type Home = Get '[HTML] [HTMLTemplate] -- Serve app under / type Main = Get '[HTML] HTMLTemplate
:<|> "app" :> Get '[HTML] [HTMLTemplate] -- Also serve app under /app type App = "app" :> Get '[HTML] HTMLTemplate
type Home = Main -- Serve app under /
type RequestFile = Raw -- For serving the workflow definitions & index.json | TODO alternatively keep data after parsing & serve as '[JSON] :<|> App -- Also serve app under /app
:<|> Raw -- File server | TODO alternatively keep data after parsing & serve as '[JSON]
instance Accept HTML where instance Accept HTML where
contentType _ = "text" // "html" contentType _ = "text" // "html"
@ -37,27 +41,30 @@ instance MimeRender HTML ByteString where
instance MimeUnrender HTML ByteString where instance MimeUnrender HTML ByteString where
mimeUnrender _ = Right mimeUnrender _ = Right
instance MimeRender HTML [HTMLTemplate] where instance MimeRender HTML HTMLTemplate where
mimeRender p template = undefined --TODO use encoding function of template library mimeRender p (HTMLTemp bs) = bs --TODO use encoding function of template library
instance MimeUnrender HTML [HTMLTemplate] where instance MimeUnrender HTML HTMLTemplate where
mimeUnrender _ bs = Right undefined -- TODO use decoding function mimeUnrender _ = Right . HTMLTemp -- TODO use decoding function
mainServer :: Server Home workFlowServer :: Server Home
mainServer = undefined workFlowServer = mainServer :<|> appServer :<|> fileServer
where
mainServer :: Server Main
mainServer = handleRequest False
appServer :: Server App
appServer = handleRequest True
fileServer :: Server Raw
fileServer = serveDirectoryFileServer directory
handleRequest :: Bool -> Handler HTMLTemplate
handleRequest appReq = do
liftIO . putStrLn $ "GET request for main application" ++ if appReq then " @/app" else ""
html <- liftIO $ BSL.U.fromString <$> readFile "editor.html"
return $ HTMLTemp html
userAPI :: Proxy Home userAPI :: Proxy Home
userAPI = Proxy userAPI = Proxy
workFlows :: Application workFlows :: Application
workFlows = serve userAPI mainServer workFlows = serve userAPI workFlowServer
fileServer :: Server RequestFile
fileServer = serveDirectoryFileServer directory
staticAPI :: Proxy RequestFile
staticAPI = Proxy
files :: Application
files = serve staticAPI fileServer

27
server/ServerMain.hs
View File

@ -4,16 +4,29 @@
module ServerMain where module ServerMain where
import Routes (workFlows, files) import Routes (workFlows)
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp ( run ) import Network.Wai.Handler.Warp ( run )
import Control.Concurrent import Control.Concurrent
serverMain :: IO () serverMain :: IO ()
serverMain = do serverMain = do
putStrLn "Starting app @ http://localhost:8081/" printGreeter
mainServerThread <- forkIO $ run 8081 workFlows -- putStrLn "Starting file server @ http://localhost:8080/"
putStrLn "Main server is running" -- fileServerThread <- forkIO $ run 8080 files
putStrLn "Starting file server @ http://localhost:8080/" -- putStrLn "File server is running\n"
run 8080 files putStrLn "Starting app @ http://localhost:8080/"
run 8080 workFlows
where
printGreeter = do
putStrLn "\n\n"
putStrLn " _.=:'^^':=._ "
putStrLn " +^ ^+ .__. .__. .__. .__."
putStrLn " +° (.**.) °+ | | | | | | / /"
putStrLn " °+ (.*oOOo*.) +° | | .__. | | | | / /"
putStrLn "+^ (.oO(00)Oo.) ^+ | |/ \\| | | |/ /"
putStrLn " °+ (.*oOOo*.) +° | | /\\ | | | | /"
putStrLn " +° (.**.) °+ | / \\ | | /"
putStrLn " °+_. ._+° |___/ \\___| |___/"
putStrLn " ^=`°°`=^"
putStrLn "\n\n"

1
workflow-visualiser.cabal
View File

@ -38,6 +38,7 @@ executable workflow-visualiser
HsYAML, HsYAML,
aeson, aeson,
bytestring, bytestring,
utf8-string,
containers, containers,
text, text,
vector, vector,