diff --git a/server/Routes.hs b/server/Routes.hs index 2e7fa48..1125422 100644 --- a/server/Routes.hs +++ b/server/Routes.hs @@ -18,6 +18,7 @@ import Data.ByteString.Lazy.Internal (ByteString) import Control.Monad.Cont (liftIO) import qualified Data.ByteString.Lazy.UTF8 as BSL.U +import Templates (renderAppHtml) directory :: FilePath @@ -60,7 +61,7 @@ workFlowServer = mainServer :<|> appServer :<|> fileServer 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" + html <- liftIO $ BSL.U.fromString <$> renderAppHtml Nothing return $ HTMLTemp html userAPI :: Proxy Home diff --git a/server/ServerMain.hs b/server/ServerMain.hs index 69e5954..82b8490 100644 --- a/server/ServerMain.hs +++ b/server/ServerMain.hs @@ -15,18 +15,18 @@ serverMain = do -- putStrLn "Starting file server @ http://localhost:8080/" -- fileServerThread <- forkIO $ run 8080 files -- putStrLn "File server is running\n" - putStrLn "Starting app @ http://localhost:8080/" + putStrLn "Starting Workflow Visualiser @ http://localhost:8080/\n" run 8080 workFlows where printGreeter = do putStrLn "\n\n" putStrLn " _.=:'^^':=._ " putStrLn " +^ ^+ .__. .__. .__. .__." - putStrLn " +° (.**.) °+ | | | | | | / /" - putStrLn " °+ (.*oOOo*.) +° | | .__. | | | | / /" - putStrLn "+^ (.oO(00)Oo.) ^+ | |/ \\| | | |/ /" - putStrLn " °+ (.*oOOo*.) +° | | /\\ | | | | /" - putStrLn " +° (.**.) °+ | / \\ | | /" + putStrLn " +° (.**.) °+ |~~| |~~| |**| /::/" + putStrLn " °+ (.*oOOo*.) +° |<>| .__. |<>| |::| /**/" + putStrLn "+^ (.oO(00)Oo.) ^+ |~~|/<><>\\|~~| |**|/::/" + putStrLn " °+ (.*oOOo*.) +° |<>|~~/\\~~|<>| |::|**/" + putStrLn " +° (.**.) °+ |~~<>/ \\<>~~| |**::/" putStrLn " °+_. ._+° |___/ \\___| |___/" putStrLn " ^=`°°`=^" putStrLn "\n\n" diff --git a/server/Templates.hs b/server/Templates.hs new file mode 100644 index 0000000..c51df36 --- /dev/null +++ b/server/Templates.hs @@ -0,0 +1,24 @@ +-- SPDX-FileCopyrightText: 2023 David Mosbach +-- +-- SPDX-License-Identifier: AGPL-3.0-or-later + +module Templates where + +import Text.EDE +import Data.Either (fromRight) +import Data.HashMap.Strict +import Data.Aeson (Value) +import Data.Maybe (fromMaybe) +import Data.Text + + +import qualified Data.Text.Lazy as TL + +type RenderContext = HashMap Text Value + + +renderAppHtml :: Maybe RenderContext -> IO String +renderAppHtml context = do + template <- eitherParseFile "editor.html" + let result = either error id $ template >>= (`eitherRender` fromMaybe (fromPairs [] :: RenderContext) context) + return $ TL.unpack result diff --git a/workflow-visualiser.cabal b/workflow-visualiser.cabal index 785617a..04a724e 100644 --- a/workflow-visualiser.cabal +++ b/workflow-visualiser.cabal @@ -30,7 +30,8 @@ executable workflow-visualiser Index, YamlParser, ServerMain, - Routes + Routes, + Templates -- LANGUAGE extensions used by modules in this package. -- other-extensions: @@ -40,6 +41,7 @@ executable workflow-visualiser bytestring, utf8-string, containers, + unordered-containers, text, vector, directory, @@ -50,6 +52,6 @@ executable workflow-visualiser wai, warp, http-media, - shakespeare + ede hs-source-dirs: app, server default-language: Haskell2010