summaryrefslogtreecommitdiff
path: root/com/influencedbybooks/apex.hs
diff options
context:
space:
mode:
Diffstat (limited to 'com/influencedbybooks/apex.hs')
-rw-r--r--com/influencedbybooks/apex.hs129
1 files changed, 0 insertions, 129 deletions
diff --git a/com/influencedbybooks/apex.hs b/com/influencedbybooks/apex.hs
deleted file mode 100644
index 32e6403..0000000
--- a/com/influencedbybooks/apex.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-
--- | Server
-module Com.Influencedbybooks.Apex where
-
-import Com.Simatime.Alpha
-import Com.Influencedbybooks.Core
-import qualified Com.Influencedbybooks.Keep as Keep
-import qualified Com.Influencedbybooks.Look as Look
-import qualified Clay
-import qualified Data.Text.Lazy as Lazy
-import qualified Data.Text.Lazy.Encoding as Lazy
-import Data.Maybe (fromMaybe)
-import Data.Acid (AcidState)
-import qualified Data.Acid.Abstract as Acid
-import qualified Lucid as L
-import Lucid.Base
-import Miso
-import Network.HTTP.Media ((//), (/:))
-import Network.HTTP.Types
-import Com.Simatime.Network
-import Network.Wai
-import Network.Wai.Application.Static
-import Network.Wai.Handler.Warp
-import Network.Wai.Middleware.Gzip
-import Network.Wai.Middleware.RequestLogger
-import Servant
-import System.Environment (lookupEnv)
-
-main :: IO ()
-main = do
- say "rise: ibb"
- port <- read
- <$> fromMaybe "3000"
- <$> lookupEnv "PORT" :: IO Int
- keep <- Keep.openLocal "keep/"
- say "port: 3000"
- run port $ logStdout $ compress $ app $ keep
- where
- compress = gzip def { gzipFiles = GzipCompress }
-
-newtype HtmlPage a = HtmlPage a
- deriving (Show, Eq)
-
-instance L.ToHtml a => L.ToHtml (HtmlPage a) where
- toHtmlRaw = L.toHtml
- toHtml (HtmlPage x) =
- L.doctypehtml_ $ do
- L.head_ $ do
- L.meta_ [L.charset_ "utf-8"]
- jsRef "/static/all.js"
- cssRef "/css/main.css"
- L.body_ $ do
- page
- where
- page = L.toHtml x
- jsRef href = L.with (L.script_ mempty)
- [ makeAttribute "src" href
- , makeAttribute "type" "text/javascript"
- , makeAttribute "async" mempty
- , makeAttribute "defer" mempty
- ]
- cssRef href = L.with
- (L.link_ mempty)
- [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href]
-
-type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action
-
-handle404 :: Application
-handle404 _ respond = respond
- $ responseLBS status404 [("Content-Type", "text/html")]
- $ renderBS
- $ toHtml
- $ HtmlPage
- $ notfound
-
-newtype CSS = CSS { unCSS :: Text }
-
-instance MimeRender CSS Text where
- mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict
-
-instance Accept CSS where
- contentType _ = "text" // "css" /: ("charset", "utf-8")
-
-type CssRoute = "css" :> "main.css" :> Get '[CSS] Text
-
-type Routes
- = "static" :> Raw
- :<|> CssRoute
- :<|> ServerRoutes
- :<|> "api" :> ApiRoutes
- :<|> Raw
-
-cssHandlers :: Server CssRoute
-cssHandlers = return . Lazy.toStrict . Clay.render
- $ Look.main
-
-app :: AcidState Keep.IbbKeep -> Application
-app keep = serve
- (Proxy @Routes)
- $ static
- :<|> cssHandlers
- :<|> serverHandlers
- :<|> apiHandlers keep
- :<|> Tagged handle404
- where
- static = serveDirectoryWith (defaultWebAppSettings "ibb.jsexe")
-
-type ApiRoutes =
- "people" :> Get '[JSON] [Person]
-
-serverHandlers :: Server ServerRoutes
-serverHandlers = homeHandler
- where
- send f u =
- pure $ HtmlPage $ f Model { uri = u, people = NotAsked }
- homeHandler = send home goHome
-
--- | for now we just have one api endpoint, which returns all the people
-apiHandlers :: AcidState Keep.IbbKeep -> Server ApiRoutes
-apiHandlers keep =
- Acid.query' keep $ Keep.GetPeople 20