71 lines
2.1 KiB
Haskell
71 lines
2.1 KiB
Haskell
{-# 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
|