Intailly working app.

app/Main.hs

@@ -1,34 +1,17 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveGeneric #-}
 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
+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 = 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)

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

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
+                      }
+

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