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
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: a75b559a48622ecf2f5c1828cceaaca1e22b3e02dd220be74a7c3ec81fb1b60b
|
-- hash: d11aa404572bc87a8da8ab8884a2b01443beea6ede73072538bcbe8a4f42ca1b
|
||||||
|
|
||||||
name: aggreact
|
name: aggreact
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
|
@ -29,6 +29,8 @@ library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Aggreact
|
Aggreact
|
||||||
Aggreact.Comments
|
Aggreact.Comments
|
||||||
|
Aggreact.Css
|
||||||
|
Servant.Clay
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_aggreact
|
Paths_aggreact
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
|
@ -43,8 +45,10 @@ library
|
||||||
, cereal
|
, cereal
|
||||||
, cereal-text
|
, cereal-text
|
||||||
, cereal-time
|
, cereal-time
|
||||||
|
, clay
|
||||||
, containers
|
, containers
|
||||||
, http-api-data
|
, http-api-data
|
||||||
|
, http-media
|
||||||
, human-readable-duration
|
, human-readable-duration
|
||||||
, ixset
|
, ixset
|
||||||
, protolude
|
, protolude
|
||||||
|
@ -66,7 +70,7 @@ executable aggreact
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
src-exe
|
src-exe
|
||||||
default-extensions: OverloadedStrings NoImplicitPrelude ScopedTypeVariables
|
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:
|
build-depends:
|
||||||
aggreact
|
aggreact
|
||||||
, base >=4.8 && <5
|
, base >=4.8 && <5
|
||||||
|
|
|
@ -33,8 +33,10 @@ library:
|
||||||
- cereal
|
- cereal
|
||||||
- cereal-text
|
- cereal-text
|
||||||
- cereal-time
|
- cereal-time
|
||||||
|
- clay
|
||||||
- containers
|
- containers
|
||||||
- http-api-data
|
- http-api-data
|
||||||
|
- http-media
|
||||||
- human-readable-duration
|
- human-readable-duration
|
||||||
- ixset
|
- ixset
|
||||||
- safecopy
|
- safecopy
|
||||||
|
@ -54,7 +56,7 @@ executables:
|
||||||
- -optP-Wno-nonportable-include-path
|
- -optP-Wno-nonportable-include-path
|
||||||
- -threaded
|
- -threaded
|
||||||
- -rtsopts
|
- -rtsopts
|
||||||
- -with-rtsopts="-N -I0"
|
- "-with-rtsopts=-N -I0"
|
||||||
dependencies:
|
dependencies:
|
||||||
- aggreact
|
- aggreact
|
||||||
tests:
|
tests:
|
||||||
|
|
|
@ -26,16 +26,20 @@ module Aggreact
|
||||||
import Protolude
|
import Protolude
|
||||||
|
|
||||||
import Aggreact.Comments
|
import Aggreact.Comments
|
||||||
|
import Aggreact.Css (genCss)
|
||||||
|
|
||||||
|
import Clay (Css)
|
||||||
import Data.Time (getCurrentTime)
|
import Data.Time (getCurrentTime)
|
||||||
import Network.Wai (Application)
|
import Network.Wai (Application)
|
||||||
import qualified Network.Wai.Handler.Warp as Warp
|
import qualified Network.Wai.Handler.Warp as Warp
|
||||||
import Servant
|
import Servant
|
||||||
|
import Servant.Clay
|
||||||
import Servant.HTML.Blaze
|
import Servant.HTML.Blaze
|
||||||
|
|
||||||
type CommentAPI =
|
type CommentAPI =
|
||||||
"comments" :> Capture "slug" Text :> Get '[HTML,JSON] CommentPage
|
"comments" :> Capture "slug" Text :> Get '[HTML,JSON] CommentPage
|
||||||
:<|> "slugs" :> Get '[JSON] [Slug]
|
:<|> "slugs" :> Get '[JSON] [Slug]
|
||||||
|
:<|> "main.css" :> Get '[CSS] Css
|
||||||
:<|> "comments" :> ReqBody '[JSON, FormUrlEncoded] NewComment :> Post '[JSON] Comment
|
:<|> "comments" :> ReqBody '[JSON, FormUrlEncoded] NewComment :> Post '[JSON] Comment
|
||||||
|
|
||||||
data Conf = Conf { port :: Int }
|
data Conf = Conf { port :: Int }
|
||||||
|
@ -55,6 +59,7 @@ api = Proxy
|
||||||
server :: DB Comments -> Server CommentAPI
|
server :: DB Comments -> Server CommentAPI
|
||||||
server db = showComments db
|
server db = showComments db
|
||||||
:<|> listSlugs db
|
:<|> listSlugs db
|
||||||
|
:<|> return genCss
|
||||||
:<|> liftIO . createNewComment db
|
:<|> liftIO . createNewComment db
|
||||||
|
|
||||||
app :: DB Comments -> Application
|
app :: DB Comments -> Application
|
||||||
|
|
|
@ -256,8 +256,9 @@ getCommentsByParentId db s = Acid.query db (CommentsByParentId s)
|
||||||
boilerplate :: Text -> H.Markup -> H.Html
|
boilerplate :: Text -> H.Markup -> H.Html
|
||||||
boilerplate url innerHtml =
|
boilerplate url innerHtml =
|
||||||
H.html $ do
|
H.html $ do
|
||||||
H.head $
|
H.head $ do
|
||||||
H.title (H.text "Aggreact")
|
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.body $ do
|
||||||
H.h1 $ do
|
H.h1 $ do
|
||||||
H.text "Aggreact: "
|
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