css
This commit is contained in:
parent
926d7c1473
commit
c55157beed
6 changed files with 50 additions and 4 deletions
|
@ -2,7 +2,7 @@
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: a75b559a48622ecf2f5c1828cceaaca1e22b3e02dd220be74a7c3ec81fb1b60b
|
||||
-- hash: d11aa404572bc87a8da8ab8884a2b01443beea6ede73072538bcbe8a4f42ca1b
|
||||
|
||||
name: aggreact
|
||||
version: 0.1.0.0
|
||||
|
@ -29,6 +29,8 @@ library
|
|||
exposed-modules:
|
||||
Aggreact
|
||||
Aggreact.Comments
|
||||
Aggreact.Css
|
||||
Servant.Clay
|
||||
other-modules:
|
||||
Paths_aggreact
|
||||
hs-source-dirs:
|
||||
|
@ -43,8 +45,10 @@ library
|
|||
, cereal
|
||||
, cereal-text
|
||||
, cereal-time
|
||||
, clay
|
||||
, containers
|
||||
, http-api-data
|
||||
, http-media
|
||||
, human-readable-duration
|
||||
, ixset
|
||||
, protolude
|
||||
|
@ -66,7 +70,7 @@ executable aggreact
|
|||
hs-source-dirs:
|
||||
src-exe
|
||||
default-extensions: OverloadedStrings NoImplicitPrelude ScopedTypeVariables
|
||||
ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -Werror -O2 -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts="-N -I0"
|
||||
ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -Werror -O2 -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N -I0
|
||||
build-depends:
|
||||
aggreact
|
||||
, base >=4.8 && <5
|
||||
|
|
|
@ -33,8 +33,10 @@ library:
|
|||
- cereal
|
||||
- cereal-text
|
||||
- cereal-time
|
||||
- clay
|
||||
- containers
|
||||
- http-api-data
|
||||
- http-media
|
||||
- human-readable-duration
|
||||
- ixset
|
||||
- safecopy
|
||||
|
@ -54,7 +56,7 @@ executables:
|
|||
- -optP-Wno-nonportable-include-path
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts="-N -I0"
|
||||
- "-with-rtsopts=-N -I0"
|
||||
dependencies:
|
||||
- aggreact
|
||||
tests:
|
||||
|
|
|
@ -26,16 +26,20 @@ module Aggreact
|
|||
import Protolude
|
||||
|
||||
import Aggreact.Comments
|
||||
import Aggreact.Css (genCss)
|
||||
|
||||
import Clay (Css)
|
||||
import Data.Time (getCurrentTime)
|
||||
import Network.Wai (Application)
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
import Servant
|
||||
import Servant.Clay
|
||||
import Servant.HTML.Blaze
|
||||
|
||||
type CommentAPI =
|
||||
"comments" :> Capture "slug" Text :> Get '[HTML,JSON] CommentPage
|
||||
:<|> "slugs" :> Get '[JSON] [Slug]
|
||||
:<|> "main.css" :> Get '[CSS] Css
|
||||
:<|> "comments" :> ReqBody '[JSON, FormUrlEncoded] NewComment :> Post '[JSON] Comment
|
||||
|
||||
data Conf = Conf { port :: Int }
|
||||
|
@ -55,6 +59,7 @@ api = Proxy
|
|||
server :: DB Comments -> Server CommentAPI
|
||||
server db = showComments db
|
||||
:<|> listSlugs db
|
||||
:<|> return genCss
|
||||
:<|> liftIO . createNewComment db
|
||||
|
||||
app :: DB Comments -> Application
|
||||
|
|
|
@ -256,8 +256,9 @@ getCommentsByParentId db s = Acid.query db (CommentsByParentId s)
|
|||
boilerplate :: Text -> H.Markup -> H.Html
|
||||
boilerplate url innerHtml =
|
||||
H.html $ do
|
||||
H.head $
|
||||
H.head $ do
|
||||
H.title (H.text "Aggreact")
|
||||
H.link H.! A.rel "stylesheet" H.! A.type_ "text/css" H.! A.href "/main.css"
|
||||
H.body $ do
|
||||
H.h1 $ do
|
||||
H.text "Aggreact: "
|
||||
|
|
12
src/Aggreact/Css.hs
Normal file
12
src/Aggreact/Css.hs
Normal file
|
@ -0,0 +1,12 @@
|
|||
module Aggreact.Css where
|
||||
|
||||
import Clay
|
||||
|
||||
genCss :: Css
|
||||
genCss =
|
||||
body ? do
|
||||
fontFamily ["Menlo"] [monospace]
|
||||
fontSize (px 14)
|
||||
maxWidth (px 800)
|
||||
lineHeight (em 1.5)
|
||||
margin (px 0) auto (px 0) auto
|
22
src/Servant/Clay.hs
Normal file
22
src/Servant/Clay.hs
Normal file
|
@ -0,0 +1,22 @@
|
|||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
module Servant.Clay where
|
||||
|
||||
import Protolude hiding (encodeUtf8)
|
||||
|
||||
import Clay (Css, compact, renderWith)
|
||||
import Data.Text.Lazy.Encoding (encodeUtf8)
|
||||
import Data.Typeable (Typeable)
|
||||
import qualified Network.HTTP.Media as M
|
||||
import Servant.API (Accept (..), MimeRender (..))
|
||||
|
||||
data CSS deriving Typeable
|
||||
|
||||
instance Accept CSS where
|
||||
contentType _ = "test" M.// "css" M./: ("charset","utf-8")
|
||||
|
||||
instance MimeRender CSS Css where
|
||||
mimeRender _ = encodeUtf8 . renderWith compact []
|
Loading…
Reference in a new issue