diff --git a/matebeamter.cabal b/matebeamter.cabal index a53815b..5fdf84e 100644 --- a/matebeamter.cabal +++ b/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 diff --git a/src/Control/User.hs b/src/Control/User.hs index da65d8b..48451d5 100644 --- a/src/Control/User.hs +++ b/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 - muser <- liftIO $ runClientM - (userList (Just MT.All)) + (ReadState manager l10n) <- ask + let loc = Locale "en" + 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 diff --git a/src/Main.hs b/src/Main.hs index aff1a45..83534ea 100644 --- a/src/Main.hs +++ b/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) diff --git a/src/Types/Page.hs b/src/Types/Page.hs index c6cd087..01ec38a 100644 --- a/src/Types/Page.hs +++ b/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 "Matebeamter" mempty mempty mempty +initPage :: Page H.Html (I18n T.Text) +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 diff --git a/src/Types/Reader.hs b/src/Types/Reader.hs index 618ad67..7c5b63f 100644 --- a/src/Types/Reader.hs +++ b/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 diff --git a/src/AuthUtil.hs b/src/Util.hs similarity index 94% rename from src/AuthUtil.hs rename to src/Util.hs index e7f5b6e..45b7dbc 100644 --- a/src/AuthUtil.hs +++ b/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 diff --git a/src/View/Auth.hs b/src/View/Auth.hs index 34e289b..8ab15d7 100644 --- a/src/View/Auth.hs +++ b/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 = template initPage $ do +authPage + :: L10n + -> Locale + -> AuthPage +authPage l10n locale = scaffold l10n locale initPage $ do H.p $ "Test" diff --git a/src/View/Scaffold.hs b/src/View/Scaffold.hs new file mode 100644 index 0000000..28ff489 --- /dev/null +++ b/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 diff --git a/src/View/User.hs b/src/View/User.hs index 18664b9..39adef7 100644 --- a/src/View/User.hs +++ b/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 = template initPage $ do - H.p $ "Test" +userPage + :: L10n + -> 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 +