Hacky html rendering.

This commit is contained in:
Dhananjay Balan 2023-03-05 15:08:02 +05:30
parent ff7cfdc796
commit 2c15c67480
4 changed files with 41 additions and 17 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -10,6 +10,7 @@ pkgs.haskellPackages.developPackage {
ghc
haskell-language-server
zlib
cabal-plan
]);
}