getting my feet wet a bit

matebeamter.cabal

@@ -18,9 +18,22 @@ extra-source-files:  CHANGELOG.md
 
 executable matebeamter
   main-is:             Main.hs
-  -- other-modules:
+  other-modules:       API
+                     , Types
+                     , Types.Page
+                     , View
+                     , View.Auth
   -- other-extensions:
   build-depends:       base ^>=4.12.0.0
-                       mateamt
+                     , mateamt
+                     , servant
+                     , servant-server
+                     , servant-client
+                     , servant-blaze
+                     , servant-rawm
+                     , blaze-html
+                     , text
+                     , warp
+                     , wai-logger
   hs-source-dirs:      src
   default-language:    Haskell2010

src/API.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module API where
+
+import Servant.API
+import Servant.RawM
+import Servant.HTML.Blaze
+
+-- internal imports
+
+import Types
+import View
+
+type UserAPI =
+  "auth" :> Get '[HTML] AuthPage

src/Main.hs

@@ -1,4 +1,28 @@
 module Main where
 
+import Servant
+import Servant.Server
+
+import Network.Wai.Handler.Warp
+import Network.Wai.Logger
+
+-- internal imports
+
+import API
+import Types
+import View
+
 main :: IO ()
-main = putStrLn "Hello, Haskell!"
+main = do
+  withStdoutLogger $ \ilog -> do
+    let settings = setPort 3000 $ setLogger ilog defaultSettings
+    runSettings settings app
+
+app :: Application
+app = serve userApi userServer
+
+userApi :: Proxy UserAPI
+userApi = Proxy
+
+userServer :: Server UserAPI
+userServer = return authPage

src/Types.hs

@@ -0,0 +1,5 @@
+module Types
+  ( module T
+  ) where
+
+import Types.Page as T

src/Types/Page.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Types.Page where
+
+import qualified Data.Text as T
+
+import qualified Text.Blaze.Html5 as H
+
+data Page markup attr = Page
+  { pageTitle               :: attr   -- ^ Page title
+  , pageFavicon             :: markup -- ^ Favicon tags
+  , pageMetaVars            :: markup -- ^ @\<meta\>@ tags
+  -- , initScripts         :: markup -- ^ JavaScript to include at the top of the page
+  -- , beforeStylesScripts :: markup -- ^ JavaScript to include before @\<style\>@ tags
+  , pageStyles              :: markup -- ^ Styles
+  -- , afterStylesScripts  :: markup -- ^ JavaScript to include after @\<style\>@ tags - ie: <http://modernizr.com Modernizr>
+  -- , bodyScripts         :: markup -- ^ JavaScript to include at the base of @\<body\>@
+  -- , bodyStyles          :: attrSet -- ^ Additional styles to assign to @\<body\>@
+  } deriving (Show, Eq, Ord)
+
+instance (Semigroup m, Semigroup a) => Semigroup (Page m a)
+  where
+    (Page t1 f1 m1 s1) <> (Page t2 f2 m2 s2) =
+      Page (t1 <> t2)
+              (f1 <> f2)
+              (m1 <> m2)
+              (s1 <> s2)
+
+instance (Monoid m, Monoid a) => Monoid (Page m a) where
+  mempty = Page mempty mempty mempty mempty
+
+initPage :: Page H.Html T.Text
+initPage = Page "Matebeamter" mempty mempty mempty
+
+template
+  :: Page H.Html T.Text
+  -> H.Html
+  -> H.Html
+template (Page title favicon meta style) content =
+  H.docTypeHtml $ do
+    H.head $ do
+      H.title $ H.toHtml $ title
+      meta
+      favicon
+      style
+    H.body $
+      content

src/View.hs

@@ -0,0 +1,5 @@
+module View
+  ( module V
+  ) where
+
+import View.Auth as V

src/View/Auth.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE OverloadedStrings #-}
+module View.Auth where
+
+import qualified Text.Blaze.Html5 as H
+
+import Types
+
+type AuthPage = H.Html
+
+authPage :: AuthPage
+authPage = template initPage $ do
+  H.p $ "Test"