Hacky html rendering.

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 ()
+type API = Get '[HTML] Quote
-main = do
+         :<|> "quotes" :> Get '[JSON] [Quote]
-  putStrLn "Hello, Haskell!"
-  let dbfile = "quotes.db"
-  initDb dbfile
-  runApp dbfile
-
-
-type API = "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 :: AppConfig -> IO ()
-runApp dbfile = run 8081 (serve api $ server dbfile)
+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

lib/Api/Types.hs

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

quotes-api.cabal

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

shell.nix

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