added EDE templating
This commit is contained in:
parent
acf3a4de83
commit
8cdca97003
@ -18,6 +18,7 @@ import Data.ByteString.Lazy.Internal (ByteString)
|
|||||||
import Control.Monad.Cont (liftIO)
|
import Control.Monad.Cont (liftIO)
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy.UTF8 as BSL.U
|
import qualified Data.ByteString.Lazy.UTF8 as BSL.U
|
||||||
|
import Templates (renderAppHtml)
|
||||||
|
|
||||||
|
|
||||||
directory :: FilePath
|
directory :: FilePath
|
||||||
@ -60,7 +61,7 @@ workFlowServer = mainServer :<|> appServer :<|> fileServer
|
|||||||
handleRequest :: Bool -> Handler HTMLTemplate
|
handleRequest :: Bool -> Handler HTMLTemplate
|
||||||
handleRequest appReq = do
|
handleRequest appReq = do
|
||||||
liftIO . putStrLn $ "GET request for main application" ++ if appReq then " @/app" else ""
|
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
|
return $ HTMLTemp html
|
||||||
|
|
||||||
userAPI :: Proxy Home
|
userAPI :: Proxy Home
|
||||||
|
|||||||
@ -15,18 +15,18 @@ serverMain = do
|
|||||||
-- putStrLn "Starting file server @ http://localhost:8080/"
|
-- putStrLn "Starting file server @ http://localhost:8080/"
|
||||||
-- fileServerThread <- forkIO $ run 8080 files
|
-- fileServerThread <- forkIO $ run 8080 files
|
||||||
-- putStrLn "File server is running\n"
|
-- putStrLn "File server is running\n"
|
||||||
putStrLn "Starting app @ http://localhost:8080/"
|
putStrLn "Starting Workflow Visualiser @ http://localhost:8080/\n"
|
||||||
run 8080 workFlows
|
run 8080 workFlows
|
||||||
where
|
where
|
||||||
printGreeter = do
|
printGreeter = do
|
||||||
putStrLn "\n\n"
|
putStrLn "\n\n"
|
||||||
putStrLn " _.=:'^^':=._ "
|
putStrLn " _.=:'^^':=._ "
|
||||||
putStrLn " +^ ^+ .__. .__. .__. .__."
|
putStrLn " +^ ^+ .__. .__. .__. .__."
|
||||||
putStrLn " +° (.**.) °+ | | | | | | / /"
|
putStrLn " +° (.**.) °+ |~~| |~~| |**| /::/"
|
||||||
putStrLn " °+ (.*oOOo*.) +° | | .__. | | | | / /"
|
putStrLn " °+ (.*oOOo*.) +° |<>| .__. |<>| |::| /**/"
|
||||||
putStrLn "+^ (.oO(00)Oo.) ^+ | |/ \\| | | |/ /"
|
putStrLn "+^ (.oO(00)Oo.) ^+ |~~|/<><>\\|~~| |**|/::/"
|
||||||
putStrLn " °+ (.*oOOo*.) +° | | /\\ | | | | /"
|
putStrLn " °+ (.*oOOo*.) +° |<>|~~/\\~~|<>| |::|**/"
|
||||||
putStrLn " +° (.**.) °+ | / \\ | | /"
|
putStrLn " +° (.**.) °+ |~~<>/ \\<>~~| |**::/"
|
||||||
putStrLn " °+_. ._+° |___/ \\___| |___/"
|
putStrLn " °+_. ._+° |___/ \\___| |___/"
|
||||||
putStrLn " ^=`°°`=^"
|
putStrLn " ^=`°°`=^"
|
||||||
putStrLn "\n\n"
|
putStrLn "\n\n"
|
||||||
|
|||||||
24
server/Templates.hs
Normal file
24
server/Templates.hs
Normal 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
|
||||||
@ -30,7 +30,8 @@ executable workflow-visualiser
|
|||||||
Index,
|
Index,
|
||||||
YamlParser,
|
YamlParser,
|
||||||
ServerMain,
|
ServerMain,
|
||||||
Routes
|
Routes,
|
||||||
|
Templates
|
||||||
|
|
||||||
-- LANGUAGE extensions used by modules in this package.
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
@ -40,6 +41,7 @@ executable workflow-visualiser
|
|||||||
bytestring,
|
bytestring,
|
||||||
utf8-string,
|
utf8-string,
|
||||||
containers,
|
containers,
|
||||||
|
unordered-containers,
|
||||||
text,
|
text,
|
||||||
vector,
|
vector,
|
||||||
directory,
|
directory,
|
||||||
@ -50,6 +52,6 @@ executable workflow-visualiser
|
|||||||
wai,
|
wai,
|
||||||
warp,
|
warp,
|
||||||
http-media,
|
http-media,
|
||||||
shakespeare
|
ede
|
||||||
hs-source-dirs: app, server
|
hs-source-dirs: app, server
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user