~alcinnz/Hearth: Add addressbar, POST-handlers, & i18n

3 files changed, 37 insertions(+), 7 deletions(-)

M Hearth.cabal
M app/Main.hs
M tpl/index.html

M Hearth.cabal => Hearth.cabal +4 -3

@@ 52,7 52,7 @@ build-type:         Simple
 extra-doc-files:    CHANGELOG.md
 
 -- Extra source files to be distributed with the package, such as examples, or a tutorial module.
--- extra-source-files:
+extra-source-files: tpl/**.html, i18n/*.json
 
 common warnings
     ghc-options: -Wall


@@ 72,7 72,7 @@ library
 
     -- Other library packages from which modules are imported.
     build-depends:    base ^>=4.17.0.0, ginger>0.10 && <1, bytestring, text,
-        file-embed, mtl, filepath
+        file-embed, mtl, filepath, aeson
 
     -- Directories containing source files.
     hs-source-dirs:   src-lib


@@ 98,7 98,8 @@ executable Hearth
         base ^>=4.17.0.0,
         Hearth,
         warp >= 3.3.31 && < 3.4, wai >= 3.2.3 && < 3.3,
-        http-types >= 0.12.3 && < 0.13, text >= 2.0.1 && < 2.1
+        wai-extra >= 3.1 && < 4, http-types >= 0.12.3 && < 0.13,
+        text >= 2.0.1 && < 2.1, bytestring >= 0.11 && < 1
 
     -- Directories containing source files.
     hs-source-dirs:   app

M app/Main.hs => app/Main.hs +22 -4

@@ 4,10 4,16 @@ module Main where
 import Network.Wai.Handler.Warp
 import Network.Wai
 import Network.HTTP.Types
+import Network.Wai.Parse
+
 import Data.Text.Lazy (fromStrict)
-import Data.Text.Lazy.Encoding (encodeUtf8)
+import qualified Data.Text as Txt
+import qualified Data.Text.Lazy.Encoding as LTxt
+import Data.Text.Encoding (decodeUtf8)
+import Data.ByteString (ByteString)
+import Data.Maybe (fromMaybe)
 
-import Hearth (renderPage)
+import Hearth (renderPage, handleForm)
 
 main :: IO ()
 main = do


@@ 15,6 21,18 @@ main = do
 
 servePage :: Application
 servePage req respond = case requestMethod req of
-  "GET" | Just resp <- renderPage (rawPathInfo req) (queryString req) ->
-    respond $ responseLBS status200 [] $ encodeUtf8 $ fromStrict resp
+  "GET" | Just resp <- renderPage (rawPathInfo req) (queryString req) (headerAcceptLang req) ->
+    respond $ responseLBS status200 [] $ LTxt.encodeUtf8 $ fromStrict resp
+  "POST" -> do
+    (query, _) <- parseRequestBodyEx defaultParseRequestBodyOptions lbsBackEnd req
+    redirect <- handleForm (rawPathInfo req) query
+    respond $ responseLBS status301 [(hLocation, redirect)] ""
   _ -> respond $ responseLBS status404 [] "Page not found!"
+
+headerAcceptLang :: Request -> [Txt.Text]
+headerAcceptLang = parseAcceptLang . lookup hAcceptLanguage . requestHeaders
+parseAcceptLang :: Maybe ByteString -> [Txt.Text]
+parseAcceptLang = map dropParam . Txt.splitOn "," . decodeUtf8 . fromMaybe "en"
+    where dropParam = Txt.takeWhile (/= ';')
+
+

M tpl/index.html => tpl/index.html +11 -0

@@ 0,0 1,11 @@
+<!DOCTYPE html>
+<html>
+<head>
+  <meta charset=utf-8 />
+  <title>{{ _["Homepage"] }}</title>
+</head>
+<body>
+  <form method="POST">
+    <p><input type="url" name="url" placeholder="{{ _['Web Address'] }}" required /></p>
+  </form>
+</body>