more blergh

matebeamter.cabal

@@ -20,7 +20,7 @@ executable matebeamter
   main-is:             Main.hs
   other-modules:       API
                      , Client
-                     , AuthUtil
+                     , Util
                      , Types
                      , Types.Page
                      , Types.Reader
@@ -28,6 +28,7 @@ executable matebeamter
                      , Control.Auth
                      , Control.User
                      , View
+                     , View.Scaffold
                      , View.Auth
                      , View.User
   -- other-extensions:
@@ -47,5 +48,7 @@ executable matebeamter
                      , wai-logger
                      , http-client
                      , mtl
+                     , i18n
   hs-source-dirs:      src
   default-language:    Haskell2010
+  ghc-options:         -Wall

src/Control/User.hs

@@ -8,6 +8,8 @@ import Servant.Client.Core.Auth
 
 import Data.Aeson (decode)
 
+import Data.Text.I18n
+
 import Control.Monad.Reader (ask)
 import Control.Monad.IO.Class (liftIO)
 
@@ -22,13 +24,18 @@ import qualified "mateamt" Types as MT
 import Types
 import Client
 import View
-import AuthUtil
+import Util
 import API
 
 userListControl :: Int -> UserHandler UserPage
 userListControl uid = do
-  manager <- liftIO $ newManager defaultManagerSettings
+  (ReadState manager l10n) <- ask
-  muser <- liftIO $ runClientM
+  let loc = Locale "en"
-        (userList (Just MT.All))
+  euser <- liftIO $ runClientM
+        (userList (Nothing))
         (mkClientEnv manager (BaseUrl Http "localhost" 8000 ""))
-  error (show muser)
+  case euser of
+    Right uss ->
+      return $ userPage l10n loc uss
+    Left err ->
+      error $ show err

src/Main.hs

@@ -10,6 +10,9 @@ import Network.HTTP.Client hiding (Proxy)
 
 import Control.Monad.Reader
 
+import Data.Text.I18n
+import Data.Text.I18n.Po
+
 -- internal imports
 
 import API
@@ -20,10 +23,12 @@ import Control
 main :: IO ()
 main = do
   manager <- newManager defaultManagerSettings
+  (l10n, _) <- getL10n "./locales"
   withStdoutLogger $ \ilog -> do
     let settings = setPort 3000 $ setLogger ilog defaultSettings
         initState = ReadState
           { rsManager = manager
+          , rsL10n    = l10n
           }
     runSettings settings (userApp initState)
 

src/Types/Page.hs

@@ -3,6 +3,8 @@ module Types.Page where
 
 import qualified Data.Text as T
 
+import Data.Text.I18n
+
 import qualified Text.Blaze.Html5 as H
 
 data Page markup attr = Page
@@ -28,17 +30,19 @@ instance (Semigroup m, Semigroup a) => Semigroup (Page m a)
 instance (Monoid m, Monoid a) => Monoid (Page m a) where
   mempty = Page mempty mempty mempty mempty
 
-initPage :: Page H.Html T.Text
+initPage :: Page H.Html (I18n T.Text)
-initPage = Page "Matebeamter" mempty mempty mempty
+initPage = Page (gettext "Matebeamter") mempty mempty mempty
 
 template
-  :: Page H.Html T.Text
+  :: Page H.Html (I18n T.Text)
+  -> L10n
+  -> Locale
   -> H.Html
   -> H.Html
-template (Page title favicon meta style) content =
+template (Page title favicon meta style) l10n locale content =
   H.docTypeHtml $ do
     H.head $ do
-      H.title $ H.toHtml $ title
+      H.title $ H.toHtml $ localize l10n locale title
       meta
       favicon
       style

src/Types/Reader.hs

@@ -6,8 +6,11 @@ import Servant (Handler)
 
 import Control.Monad.Reader (ReaderT)
 
+import Data.Text.I18n
+
 data ReadState = ReadState
   { rsManager :: Manager
+  , rsL10n    :: L10n
   }
 
 type UserHandler = ReaderT ReadState Handler

src/Util.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
-module AuthUtil where
+module Util where
 
 import Servant hiding (addHeader)
 import Servant.Client

src/View/Auth.hs

@@ -3,10 +3,19 @@ module View.Auth where
 
 import qualified Text.Blaze.Html5 as H
 
+import Data.Text.I18n
+
+-- internal imports
+
 import Types
 
+import View.Scaffold
+
 type AuthPage = H.Html
 
-authPage :: AuthPage
+authPage
-authPage = template initPage $ do
+  :: L10n
+  -> Locale
+  -> AuthPage
+authPage l10n locale = scaffold l10n locale initPage $ do
   H.p $ "Test"

src/View/Scaffold.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+module View.Scaffold where
+
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as H
+
+import qualified Data.Text as T
+
+import Data.Text.I18n
+
+-- internal imports
+
+import Types.Page
+
+scaffold
+  :: L10n
+  -> Locale
+  -> Page H.Html (I18n T.Text)
+  -> H.Html
+  -> H.Html
+scaffold l10n locale page content = template page l10n locale $ do
+  H.header $ H.nav $ H.ul $ do
+    H.li $ H.a H.! H.href "/" $ H.toHtml $ localize l10n locale $ gettext "Home"
+  H.hr
+  H.div H.! H.id "main" H.! H.role "main" $ do
+    content

src/View/User.hs

@@ -1,12 +1,33 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
 module View.User where
 
 import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as H
+
+import Data.Text.I18n
+
+import Data.String (fromString)
+
+-- imports from mateamt
+
+import qualified "mateamt" Types as MT
+
+-- internal imports
 
 import Types
+import View.Scaffold
 
 type UserPage = H.Html
 
-userPage :: UserPage
+userPage
-userPage = template initPage $ do
+  :: L10n
-  H.p $ "Test"
+  -> Locale
+  -> [MT.UserSummary]
+  -> UserPage
+userPage l10n locale uss = scaffold l10n locale (initPage
+  { pageTitle = gettext "Matebeamter - User list"
+  }) $ mapM_ (\(MT.UserSummary uid ident _) -> do
+    H.a H.! H.href ("#" <> fromString (show uid)) $ H.toHtml ident
+    ) uss
+