Hacky html rendering.
This commit is contained in:
parent
ff7cfdc796
commit
2c15c67480
29
app/Main.hs
29
app/Main.hs
@ -9,22 +9,18 @@ import Network.Wai.Handler.Warp
|
||||
import Data.Proxy
|
||||
import Servant
|
||||
import Control.Monad.IO.Class
|
||||
import Servant.HTML.Blaze
|
||||
|
||||
import Api.Types
|
||||
import qualified Parsers.KOReader as KO
|
||||
import Config
|
||||
import Options.Applicative
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "Hello, Haskell!"
|
||||
let dbfile = "quotes.db"
|
||||
initDb dbfile
|
||||
runApp dbfile
|
||||
|
||||
|
||||
type API = "quotes" :> Get '[JSON] [Quote]
|
||||
type API = Get '[HTML] Quote
|
||||
:<|> "quotes" :> Get '[JSON] [Quote]
|
||||
:<|> "quote" :> "random" :> Get '[JSON] Quote
|
||||
:<|> "today" :> Get '[HTML] Quote
|
||||
:<|> "koreader" :> ReqBody '[JSON] KO.KoHighlight :> Post '[JSON] NoContent
|
||||
|
||||
api :: Proxy API
|
||||
api = Proxy
|
||||
|
||||
@ -40,7 +36,7 @@ initDb dbFile = withConnection dbFile $ \conn ->
|
||||
|
||||
-- | TODO: readerT
|
||||
server :: FilePath -> Server API
|
||||
server dbf = listQuotes dbf :<|> randomQuote dbf :<|> addKoReader dbf
|
||||
server dbf = randomQuote dbf :<|> listQuotes dbf :<|> randomQuote dbf :<|> randomQuote dbf :<|> addKoReader dbf
|
||||
-- | API begins here
|
||||
randomQuote :: FilePath -> Handler Quote
|
||||
randomQuote db = do
|
||||
@ -63,5 +59,12 @@ addKoReader db hl = do
|
||||
qry = [sql|INSERT INTO quotes VALUES (?,?,?,?,?,?);|]
|
||||
qts = KO.parse hl
|
||||
|
||||
runApp :: FilePath -> IO ()
|
||||
runApp dbfile = run 8081 (serve api $ server dbfile)
|
||||
runApp :: AppConfig -> IO ()
|
||||
runApp c = run (appPort c) (serve api $ server (appDbFile c))
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
conf <- execParser parserOpts
|
||||
putStrLn $ "running with conf" <> show conf
|
||||
initDb (appDbFile conf)
|
||||
runApp conf
|
||||
|
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Api.Types
|
||||
( Quote(..)
|
||||
)
|
||||
@ -12,6 +12,9 @@ import Data.Aeson
|
||||
import Data.Text (Text)
|
||||
import Deriving.Aeson
|
||||
import Database.SQLite.Simple.ToField (ToField(toField))
|
||||
import Text.Blaze
|
||||
import qualified Text.Blaze.Html5 as HS
|
||||
import qualified Text.Blaze.Html5.Attributes as HSA
|
||||
|
||||
data Quote = Quote { qQuote :: Text
|
||||
, qAuthor :: Text
|
||||
@ -33,3 +36,15 @@ instance ToRow Quote where
|
||||
toField (qPage q),
|
||||
toField (qChapter q),
|
||||
toField (qCreatedOn q)]
|
||||
|
||||
instance ToMarkup Quote where
|
||||
toMarkup q = HS.html $ do
|
||||
HS.head $ do
|
||||
HS.title "random quote"
|
||||
HS.link ! HSA.rel "stylesheet" ! HSA.type_ "text/css" ! HSA.href "https://unpkg.com/tachyons@4.12.0/css/tachyons.min.css"
|
||||
HS.body ! HSA.class_ "w-100 sans-serif" $ do
|
||||
HS.div ! HSA.class_ "fl f5 pa4 w-100" $ HS.a ! HSA.href "https://git.planet-express.in/dbalan/quotes-api" $ "built with quotes-api"
|
||||
HS.div ! HSA.class_ "fl center pa4" $ do
|
||||
HS.div ! HSA.class_ "f2 f1-ns measure fw7 lh-title mt0" $ HS.toHtml (qQuote q)
|
||||
HS.div ! HSA.class_ "f3 fl w-80" $ HS.toHtml (qAuthor q)
|
||||
HS.div ! HSA.class_ "f4 fl w-80" $ HS.toHtml $ qTitle q
|
||||
|
@ -60,8 +60,8 @@ library
|
||||
|
||||
-- Modules exported by the library.
|
||||
exposed-modules: Api.Types,
|
||||
Parsers.KOReader
|
||||
|
||||
Parsers.KOReader,
|
||||
Config,
|
||||
-- Modules included in this library but not exported.
|
||||
-- other-modules:
|
||||
|
||||
@ -76,6 +76,9 @@ library
|
||||
bytestring,
|
||||
unordered-containers,
|
||||
sqlite-simple,
|
||||
blaze-markup,
|
||||
blaze-html,
|
||||
optparse-applicative,
|
||||
-- Directories containing source files.
|
||||
hs-source-dirs: lib
|
||||
|
||||
@ -105,7 +108,9 @@ executable quotes-api
|
||||
warp,
|
||||
aeson,
|
||||
deriving-aeson,
|
||||
quotes-api
|
||||
quotes-api,
|
||||
servant-blaze,
|
||||
optparse-applicative,
|
||||
|
||||
-- Directories containing source files.
|
||||
hs-source-dirs: app
|
||||
|
Loading…
Reference in New Issue
Block a user