unified both servers

server/Routes.hs

@@ -15,18 +15,22 @@ import Servant.API
 import Servant.Server
 import Network.HTTP.Media ((//), (/:))
 import Data.ByteString.Lazy.Internal (ByteString)
+import Control.Monad.Cont (liftIO)
+
+import qualified Data.ByteString.Lazy.UTF8 as BSL.U
 
 
 directory :: FilePath
 directory = "." -- Directory of the static files
 
 data HTML
-data HTMLTemplate
+newtype HTMLTemplate = HTMLTemp ByteString
 
-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]
+type Main = Get '[HTML] HTMLTemplate
+type App = "app" :> Get '[HTML] HTMLTemplate
+type Home = Main -- Serve app under /
+       :<|> App  -- Also serve app under /app
+       :<|> Raw  -- File server | TODO alternatively keep data after parsing & serve as '[JSON]
 
 instance Accept HTML where
   contentType _ = "text" // "html"
@@ -37,27 +41,30 @@ instance MimeRender HTML ByteString where
 instance MimeUnrender HTML ByteString where
   mimeUnrender _ = Right
 
-instance MimeRender HTML [HTMLTemplate] where
-  mimeRender p template = undefined --TODO use encoding function of template library
+instance MimeRender HTML HTMLTemplate where
+  mimeRender p (HTMLTemp bs) = bs --TODO use encoding function of template library
 
-instance MimeUnrender HTML [HTMLTemplate] where
-  mimeUnrender _ bs = Right undefined -- TODO use decoding function
+instance MimeUnrender HTML HTMLTemplate where
+  mimeUnrender _ = Right . HTMLTemp -- TODO use decoding function
 
 
-mainServer :: Server Home
-mainServer = undefined
+workFlowServer :: Server Home
+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
 
 workFlows :: Application
-workFlows = serve userAPI mainServer
-
-fileServer :: Server RequestFile
-fileServer = serveDirectoryFileServer directory
-
-staticAPI :: Proxy RequestFile
-staticAPI = Proxy
-
-files :: Application
-files = serve staticAPI fileServer
+workFlows = serve userAPI workFlowServer

server/ServerMain.hs

@@ -4,16 +4,29 @@
 
 module ServerMain where
 
-import Routes (workFlows, files)
+import Routes (workFlows)
 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
-
+  printGreeter
+  -- putStrLn "Starting file server @ http://localhost:8080/"
+  -- fileServerThread <- forkIO $ run 8080 files
+  -- putStrLn "File server is running\n"
+  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"

workflow-visualiser.cabal

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