diff --git a/.gitignore b/.gitignore index 7d4322b..a5cea65 100644 --- a/.gitignore +++ b/.gitignore @@ -3,6 +3,7 @@ # SPDX-License-Identifier: AGPL-3.0-or-later /dist-newstyle +/dsl/dist-newstyle .stack-work CHANGELOG.md test.json diff --git a/app/Main.hs b/app/Main.hs index 542bfb9..72e2982 100644 --- a/app/Main.hs +++ b/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 diff --git a/server/Routes.hs b/server/Routes.hs new file mode 100644 index 0000000..a4a4671 --- /dev/null +++ b/server/Routes.hs @@ -0,0 +1,63 @@ +-- SPDX-FileCopyrightText: 2023 David Mosbach +-- +-- 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 \ No newline at end of file diff --git a/server/ServerMain.hs b/server/ServerMain.hs new file mode 100644 index 0000000..4e421a3 --- /dev/null +++ b/server/ServerMain.hs @@ -0,0 +1,19 @@ +-- SPDX-FileCopyrightText: 2023 David Mosbach +-- +-- 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 + diff --git a/workflow-visualiser.cabal b/workflow-visualiser.cabal index ad349d9..bbcc343 100644 --- a/workflow-visualiser.cabal +++ b/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