From ff7cfdc796949d24ee01868866a4eb9f7f46c6ff Mon Sep 17 00:00:00 2001 From: Dhananjay Balan Date: Mon, 27 Feb 2023 23:46:29 +0530 Subject: [PATCH] Intailly working app. --- app/Main.hs | 56 ++++++++++++++++++++--------------- lib/Api/Types.hs | 35 ++++++++++++++++++++++ lib/{ => Parsers}/KOReader.hs | 35 ++++++++++++++++++++-- quotes-api.cabal | 4 ++- 4 files changed, 102 insertions(+), 28 deletions(-) create mode 100644 lib/Api/Types.hs rename lib/{ => Parsers}/KOReader.hs (68%) diff --git a/app/Main.hs b/app/Main.hs index 36fe8de..85702d8 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,34 +1,17 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeOperators #-} module Main where -import Data.Text (Text) -import Data.Aeson import Database.SQLite.Simple import Database.SQLite.Simple.QQ import Network.Wai.Handler.Warp -import Deriving.Aeson import Data.Proxy import Servant - import Control.Monad.IO.Class -data Quote = Quote { qQuote :: Text - , qAuthor :: Text - , qTitle :: Text - -- , qPage :: Text - -- , qChapter :: Text - -- , qTime :: UnixTime - } deriving (Show, Eq, Ord, Generic) - deriving (FromJSON,ToJSON) - via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "q", CamelToSnake]] Quote - -instance FromRow Quote where - fromRow = Quote <$> field <*> field <*> field - +import Api.Types +import qualified Parsers.KOReader as KO main :: IO () main = do @@ -38,7 +21,9 @@ main = do runApp dbfile -type API = Get '[JSON] [Quote] +type API = "quotes" :> Get '[JSON] [Quote] + :<|> "quote" :> "random" :> Get '[JSON] Quote + :<|> "koreader" :> ReqBody '[JSON] KO.KoHighlight :> Post '[JSON] NoContent api :: Proxy API api = Proxy @@ -46,14 +31,37 @@ 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, book text)|] + [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 = listQuotes dbf - +server dbf = listQuotes 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 :: FilePath -> IO () runApp dbfile = run 8081 (serve api $ server dbfile) diff --git a/lib/Api/Types.hs b/lib/Api/Types.hs new file mode 100644 index 0000000..2d282e8 --- /dev/null +++ b/lib/Api/Types.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DeriveGeneric #-} + +module Api.Types +( Quote(..) +) +where + +import Database.SQLite.Simple +import Data.Aeson +import Data.Text (Text) +import Deriving.Aeson +import Database.SQLite.Simple.ToField (ToField(toField)) + +data Quote = Quote { qQuote :: Text + , qAuthor :: Text + , qTitle :: Text + , qPage :: Text + , qChapter :: Maybe Text + , qCreatedOn :: Maybe Integer + } deriving (Show, Eq, Ord, Generic) + deriving (FromJSON,ToJSON) + via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "q", CamelToSnake]] Quote + +instance FromRow Quote where + fromRow = Quote <$> field <*> field <*> field <*> field <*> field <*> field + +instance ToRow Quote where + toRow q = [toField (qQuote q), + toField (qAuthor q), + toField (qTitle q), + toField (qPage q), + toField (qChapter q), + toField (qCreatedOn q)] diff --git a/lib/KOReader.hs b/lib/Parsers/KOReader.hs similarity index 68% rename from lib/KOReader.hs rename to lib/Parsers/KOReader.hs index 093b058..abdaf08 100644 --- a/lib/KOReader.hs +++ b/lib/Parsers/KOReader.hs @@ -3,17 +3,27 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -module KOReader where +module Parsers.KOReader +( KoHighlight(..) +, parse +) +where import Deriving.Aeson import Data.Aeson -import Data.Text +import Data.Text hiding (concatMap) +import Data.Maybe (fromMaybe) + +import Api.Types (Quote(..)) showT :: Show a => a -> Text showT = pack . show newtype KoPage = KoPage Text - deriving (Show, Eq, Generic) + deriving (Eq, Generic) + +instance Show KoPage where + show (KoPage a) = Data.Text.unpack a instance FromJSON KoPage where parseJSON (Number s) = pure (KoPage $ showT $ round s) @@ -49,3 +59,22 @@ data KoEntry = KoEntry { koeChapter :: Maybe Text deriving (Show, Eq, Generic) deriving (FromJSON, ToJSON) via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "koe", CamelToSnake]] KoEntry + +parse :: KoHighlight -> [Quote] +parse khl = concatMap parseDocument (khlDocuments khl) + +parseDocument :: KoDocument -> [Quote] +parseDocument kd = (parseEntry title author) <$> (kodEntries kd) + where + title = kodTitle kd + author = kodAuthor kd + +parseEntry :: Text -> Maybe Text -> KoEntry -> Quote +parseEntry title author ke = Quote { qQuote = koeText ke + , qAuthor = fromMaybe "" author + , qTitle = title + , qPage = showT $ koePage ke + , qChapter = koeChapter ke + , qCreatedOn = koeTime ke + } + diff --git a/quotes-api.cabal b/quotes-api.cabal index afbe51c..1c94b03 100644 --- a/quotes-api.cabal +++ b/quotes-api.cabal @@ -59,7 +59,8 @@ library import: warnings -- Modules exported by the library. - exposed-modules: KOReader + exposed-modules: Api.Types, + Parsers.KOReader -- Modules included in this library but not exported. -- other-modules: @@ -74,6 +75,7 @@ library deriving-aeson, bytestring, unordered-containers, + sqlite-simple, -- Directories containing source files. hs-source-dirs: lib