90 lines
2.4 KiB
Haskell
90 lines
2.4 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
-- import Lib
|
|
import Data.Text.Lazy (Text)
|
|
import Network.Wai.Handler.Warp (Port)
|
|
import Text.Blaze ((!))
|
|
import Text.Blaze.Html.Renderer.Text (renderHtml)
|
|
|
|
import Network.HTTP.Types
|
|
import Web.Scotty as S
|
|
|
|
import qualified Control.Exception as E
|
|
import qualified Text.Blaze.Html5 as H
|
|
import qualified Text.Blaze.Html5.Attributes as A
|
|
|
|
-- HTML
|
|
index :: H.Html -> Text
|
|
index compiledElmApp = renderHtml $ do
|
|
H.docTypeHtml $ do
|
|
H.head $ do
|
|
H.title "TESTING Scotty+Elm"
|
|
H.style "body{margin:0px;}"
|
|
(H.body ! A.id "body") $ do
|
|
embedJs compiledElmApp
|
|
|
|
-- CONF
|
|
port :: Port
|
|
port = 8080
|
|
|
|
adminContact :: String
|
|
adminContact = "[Matrix] @mtgmonkey:calitabby.net"
|
|
|
|
compiledElmAppFile :: AssetPath
|
|
compiledElmAppFile = "/js/main.js"
|
|
|
|
boilerplateJsFile :: AssetPath
|
|
boilerplateJsFile = "/js/init.js"
|
|
|
|
assetsFolder :: FilePath
|
|
assetsFolder = "/home/mtgmonkey/elmskell/assets"
|
|
|
|
-- MAIN
|
|
main :: IO ()
|
|
main = do
|
|
compiledElmAppOrExc <- E.try $ readFile $ assetsFolder ++ compiledElmAppFile :: IO (Either E.IOException String)
|
|
let compiledElmApp = case compiledElmAppOrExc of
|
|
Left e -> serverErrorReadFile e
|
|
Right contents -> H.toHtml $ contents
|
|
|
|
boilerplateJsOrExc <- E.try $ readFile $ assetsFolder ++ boilerplateJsFile :: IO (Either E.IOException String)
|
|
let boilerplateJs = case boilerplateJsOrExc of
|
|
Left e -> serverErrorReadFile e
|
|
Right contents -> H.toHtml $ contents
|
|
|
|
let anyRoute = regex "^.*$"
|
|
scotty port $ do
|
|
|
|
-- GET requests
|
|
get "/" $ do
|
|
status ok200
|
|
S.html $ index $ do
|
|
compiledElmApp
|
|
"\n"
|
|
boilerplateJs
|
|
|
|
get "/favicon.ico/" $ do
|
|
status notFound404
|
|
S.html $ "you want a favi-<i>what</i>now!?"
|
|
|
|
-- ERR
|
|
notFound $ do
|
|
status methodNotAllowed405
|
|
S.text "Verb disallowed; OR, route doesn't exist :("
|
|
|
|
|
|
-- FUNC
|
|
serverErrorReadFile :: E.IOException -> Js
|
|
serverErrorReadFile e = H.toHtml $ "document.getElementById('body').innerHTML='Server-side error occurred: "
|
|
++ (show e)
|
|
++ "; report this to a site administrator: "
|
|
++ adminContact
|
|
++ "';"
|
|
|
|
embedJs :: Js -> H.Html
|
|
embedJs js = H.script $ js
|
|
|
|
-- TYPES
|
|
type AssetPath = FilePath
|
|
type Js = H.Html
|