Intailly working app.
This commit is contained in:
parent
6921c98014
commit
ff7cfdc796
56
app/Main.hs
56
app/Main.hs
@ -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
35
lib/Api/Types.hs
Normal 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)]
|
@ -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
|
||||||
|
}
|
||||||
|
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user