From 7de4d9d0c20c9a2a29e9a3f9447f0d2eea258719 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 8 Sep 2019 02:37:50 +0200 Subject: [PATCH] getting my feet wet a bit --- matebeamter.cabal | 17 +++++++++++++++-- src/API.hs | 23 +++++++++++++++++++++++ src/Main.hs | 26 +++++++++++++++++++++++++- src/Types.hs | 5 +++++ src/Types/Page.hs | 46 ++++++++++++++++++++++++++++++++++++++++++++++ src/View.hs | 5 +++++ src/View/Auth.hs | 12 ++++++++++++ 7 files changed, 131 insertions(+), 3 deletions(-) create mode 100644 src/API.hs create mode 100644 src/Types.hs create mode 100644 src/Types/Page.hs create mode 100644 src/View.hs create mode 100644 src/View/Auth.hs diff --git a/matebeamter.cabal b/matebeamter.cabal index 3bab984..52b7dcd 100644 --- a/matebeamter.cabal +++ b/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 diff --git a/src/API.hs b/src/API.hs new file mode 100644 index 0000000..cd0349d --- /dev/null +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index 65ae4a0..911b77f 100644 --- a/src/Main.hs +++ b/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 diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 index 0000000..bff778a --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,5 @@ +module Types + ( module T + ) where + +import Types.Page as T diff --git a/src/Types/Page.hs b/src/Types/Page.hs new file mode 100644 index 0000000..c6cd087 --- /dev/null +++ b/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 -- ^ @\@ tags + -- , initScripts :: markup -- ^ JavaScript to include at the top of the page + -- , beforeStylesScripts :: markup -- ^ JavaScript to include before @\@ tags + , pageStyles :: markup -- ^ Styles + -- , afterStylesScripts :: markup -- ^ JavaScript to include after @\@ tags - ie: + -- , bodyScripts :: markup -- ^ JavaScript to include at the base of @\@ + -- , bodyStyles :: attrSet -- ^ Additional styles to assign to @\@ + } 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 diff --git a/src/View.hs b/src/View.hs new file mode 100644 index 0000000..24b6bf5 --- /dev/null +++ b/src/View.hs @@ -0,0 +1,5 @@ +module View + ( module V + ) where + +import View.Auth as V diff --git a/src/View/Auth.hs b/src/View/Auth.hs new file mode 100644 index 0000000..34e289b --- /dev/null +++ b/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"