cadey
/
time-wasting-thread-memorial
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

move HTML rendering baggage to Utils

This commit is contained in:
Christine Dodrill 2015-07-29 22:33:14 -07:00
parent a8147c2461
commit 6bb5d0db06
2 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
web/src/Main.hs
View File

@ -5,19 +5,16 @@ module Main where
import Control.Monad.IO.Class import Control.Monad.IO.Class
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Text as Text
import Data.Text.Lazy (toStrict)
import qualified Database.SQLite.Simple as Db import qualified Database.SQLite.Simple as Db
import qualified Network.HTTP.Types.Status as Status import qualified Network.HTTP.Types.Status as Status
import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
import qualified Network.Wai.Middleware.Static as Static import qualified Network.Wai.Middleware.Static as Static
import Text.Blaze.Renderer.Text
import Web.Spock ((<//>)) import Web.Spock ((<//>))
import qualified Web.Spock as S import qualified Web.Spock as S
import qualified Within.DBMemorial.Post as Post import qualified Within.DBMemorial.Post as Post
import qualified Within.DBMemorial.User as User import qualified Within.DBMemorial.User as User
import Within.DBMemorial.Utils
import qualified Within.DBMemorial.Views.Error as ErrorView import qualified Within.DBMemorial.Views.Error as ErrorView
import qualified Within.DBMemorial.Views.Materialize as Materialize
import qualified Within.DBMemorial.Views.Thread as Thread import qualified Within.DBMemorial.Views.Thread as Thread
main :: IO () main :: IO ()
@ -40,10 +37,10 @@ main = do
-- Test routes -- Test routes
S.get S.root $ S.get S.root $
S.html $ toStrict (renderMarkup (Materialize.render "The OP" (Post.render h user))) S.html $ wrapMarkup "The OP" (Post.render h user)
S.get "user" $ S.get "user" $
S.html $ toStrict (renderMarkup (Materialize.render "The first poster" (User.render user))) S.html $ wrapMarkup "The first poster" (User.render user)
-- Real routes -- Real routes
S.get ("page" <//> S.var) $ \(id_ :: Int) -> do S.get ("page" <//> S.var) $ \(id_ :: Int) -> do
@ -57,9 +54,10 @@ main = do
let page = ErrorView.render ("no data for page number " ++ (show id_)) let page = ErrorView.render ("no data for page number " ++ (show id_))
S.html $ toStrict $ (renderMarkup (Materialize.render (Text.pack ("Can't find page " ++ (show id_))) page)) S.html $ wrapMarkupStringTitle ("Can't find page " ++ (show id_)) page
_ -> do _ -> do
let title = "Thread page " ++ (show id_) let title = "Thread page " ++ (show id_)
page = Thread.render id_ posts userMap page = Thread.render id_ posts userMap
S.html $ toStrict (renderMarkup (Materialize.render (Text.pack title) page)) S.html $ wrapMarkupStringTitle title page

15
web/src/Within/DBMemorial/Utils.hs
View File

@ -1,5 +1,20 @@
module Within.DBMemorial.Utils where module Within.DBMemorial.Utils where
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Lazy (toStrict)
import Text.Blaze.Html (Html)
import Text.Blaze.Renderer.Text
import qualified Within.DBMemorial.Views.Materialize as Materialize
-- https://hackage.haskell.org/package/base-4.8.0.0/docs/src/Data-Function.html#%26 -- https://hackage.haskell.org/package/base-4.8.0.0/docs/src/Data-Function.html#%26
(&) :: a -> (a -> b) -> b (&) :: a -> (a -> b) -> b
x & f = f x x & f = f x
wrapMarkup :: Text -> Html -> Text
wrapMarkup title body =
toStrict $ renderMarkup $ Materialize.render title body
wrapMarkupStringTitle :: String -> Html -> Text
wrapMarkupStringTitle title body =
wrapMarkup (Text.pack title) body