added EDE templating

This commit is contained in:
David Mosbach 2023-09-05 04:28:36 +02:00
parent acf3a4de83
commit 8cdca97003
4 changed files with 36 additions and 9 deletions

View File

@ -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

View File

@ -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"

24
server/Templates.hs Normal file
View File

@ -0,0 +1,24 @@
-- SPDX-FileCopyrightText: 2023 David Mosbach <david.mosbach@campus.lmu.de>
--
-- 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

View File

@ -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