Intailly working app.

This commit is contained in:
Dhananjay Balan 2023-02-27 23:46:29 +05:30
parent 6921c98014
commit ff7cfdc796
4 changed files with 102 additions and 28 deletions

View File

@ -1,34 +1,17 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
module Main where module Main where
import Data.Text (Text)
import Data.Aeson
import Database.SQLite.Simple import Database.SQLite.Simple
import Database.SQLite.Simple.QQ import Database.SQLite.Simple.QQ
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Deriving.Aeson
import Data.Proxy import Data.Proxy
import Servant import Servant
import Control.Monad.IO.Class import Control.Monad.IO.Class
data Quote = Quote { qQuote :: Text import Api.Types
, qAuthor :: Text import qualified Parsers.KOReader as KO
, 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
main :: IO () main :: IO ()
main = do main = do
@ -38,7 +21,9 @@ main = do
runApp dbfile 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 API
api = Proxy api = Proxy
@ -46,14 +31,37 @@ api = Proxy
initDb :: FilePath -> IO () initDb :: FilePath -> IO ()
initDb dbFile = withConnection dbFile $ \conn -> initDb dbFile = withConnection dbFile $ \conn ->
execute_ 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 :: 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 :: FilePath -> Handler [Quote]
listQuotes db = liftIO $ withConnection db $ \conn -> query_ conn [sql|SELECT * FROM quotes;|] 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 :: FilePath -> IO ()
runApp dbfile = run 8081 (serve api $ server dbfile) runApp dbfile = run 8081 (serve api $ server dbfile)

35
lib/Api/Types.hs Normal file
View File

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

View File

@ -3,17 +3,27 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module KOReader where module Parsers.KOReader
( KoHighlight(..)
, parse
)
where
import Deriving.Aeson import Deriving.Aeson
import Data.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 :: Show a => a -> Text
showT = pack . show showT = pack . show
newtype KoPage = KoPage Text 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 instance FromJSON KoPage where
parseJSON (Number s) = pure (KoPage $ showT $ round s) parseJSON (Number s) = pure (KoPage $ showT $ round s)
@ -49,3 +59,22 @@ data KoEntry = KoEntry { koeChapter :: Maybe Text
deriving (Show, Eq, Generic) deriving (Show, Eq, Generic)
deriving (FromJSON, ToJSON) deriving (FromJSON, ToJSON)
via CustomJSON '[OmitNothingFields, FieldLabelModifier '[StripPrefix "koe", CamelToSnake]] KoEntry 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
}

View File

@ -59,7 +59,8 @@ library
import: warnings import: warnings
-- Modules exported by the library. -- Modules exported by the library.
exposed-modules: KOReader exposed-modules: Api.Types,
Parsers.KOReader
-- Modules included in this library but not exported. -- Modules included in this library but not exported.
-- other-modules: -- other-modules:
@ -74,6 +75,7 @@ library
deriving-aeson, deriving-aeson,
bytestring, bytestring,
unordered-containers, unordered-containers,
sqlite-simple,
-- Directories containing source files. -- Directories containing source files.
hs-source-dirs: lib hs-source-dirs: lib