quotes-api/app/Main.hs

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Main where

import Database.SQLite.Simple
import Database.SQLite.Simple.QQ
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

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

initDb :: FilePath -> IO ()
initDb dbFile = withConnection dbFile $ \conn ->
  execute_ conn
    [sql|CREATE TABLE IF NOT EXISTS quotes ( quote text non null
                                           , author text
                                           , title text
                                           , page text
                                           , chapter text
                                           , created_on integer);|]

-- | TODO: readerT
server :: FilePath -> Server API
server dbf = randomQuote dbf :<|> listQuotes dbf :<|> randomQuote dbf :<|> randomQuote dbf :<|> addKoReader dbf
-- | API begins here
randomQuote :: FilePath -> Handler Quote
randomQuote db = do
  qts <- (liftIO $ withConnection db $ \c -> query_ c qry)
  case (length qts) of
    0 -> undefined
    _ -> pure (head qts)
  where
    qry = [sql|SELECT * FROM quotes ORDER BY RANDOM();|]

listQuotes :: FilePath -> Handler [Quote]
listQuotes db = liftIO $ withConnection db $ \conn -> query_ conn [sql|SELECT * FROM quotes;|]

addKoReader :: FilePath -> KO.KoHighlight -> Handler NoContent
addKoReader db hl = do
  liftIO $ withConnection db $ \c ->
    executeMany c qry qts
  pure NoContent
  where
    qry = [sql|INSERT INTO quotes VALUES (?,?,?,?,?,?);|]
    qts = KO.parse hl

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