From e2f7ebe6de4059185b135c98fedeaddeece9d412 Mon Sep 17 00:00:00 2001 From: Dhananjay Balan Date: Tue, 11 Apr 2023 11:02:42 +0200 Subject: [PATCH] WIP: readwise. --- app/Main.hs | 21 +++++++++++++++--- lib/Parsers/Readwise.hs | 49 +++++++++++++++++++++++++++++++++++++++++ quotes-api.cabal | 6 ++++- shell.nix | 37 ++++++++++++++++++------------- 4 files changed, 94 insertions(+), 19 deletions(-) create mode 100644 lib/Parsers/Readwise.hs diff --git a/app/Main.hs b/app/Main.hs index 4c48b28..2001d61 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,13 +11,15 @@ import Servant import Control.Monad.IO.Class import Servant.HTML.Blaze import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Crypto.Argon2 import Data.Text.Short (fromText, ShortText) import Data.ByteString (ByteString) +import Data.ByteString.Lazy (fromStrict) import Api.Types import qualified Parsers.KOReader as KO +import qualified Parsers.Readwise as RW import Config import Options.Applicative @@ -30,7 +32,8 @@ type API = Get '[HTML] Quote :<|> "quotes" :> Get '[JSON] [Quote] :<|> "quote" :> "random" :> Get '[JSON] Quote :<|> "today" :> Get '[HTML] Quote - :<|> BasicAuth "update data" User :> ("koreader" :> ReqBody '[JSON] KO.KoHighlight :> Post '[JSON] NoContent) + :<|> BasicAuth "update data" User :> ( "koreader" :> ReqBody '[JSON] KO.KoHighlight :> Post '[JSON] NoContent + :<|> "readwise" :> ReqBody '[PlainText] T.Text :> Post '[JSON] NoContent) api :: Proxy API api = Proxy @@ -59,7 +62,11 @@ initDb dbFile = withConnection dbFile $ \conn -> -- | TODO: readerT server :: FilePath -> Server API -server dbf = randomQuote dbf :<|> listQuotes dbf :<|> randomQuote dbf :<|> randomQuote dbf :<|> (\_ -> addKoReader dbf) +server dbf = randomQuote dbf + :<|> listQuotes dbf + :<|> randomQuote dbf + :<|> randomQuote dbf + :<|> (\_ -> (addKoReader dbf :<|> addReadwise dbf)) -- | API begins here randomQuote :: FilePath -> Handler Quote @@ -83,6 +90,14 @@ addKoReader db hl = do qry = [sql|INSERT INTO quotes VALUES (?,?,?,?,?,?);|] qts = KO.parse hl +addReadwise :: FilePath -> T.Text -> Handler NoContent +addReadwise db hl = do + let + qts = RW.parse (fromStrict $ encodeUtf8 hl) + liftIO $ print $ show qts + pure NoContent + + runApp :: AppConfig -> IO () runApp c = run (appPort c) (serveWithContext api ctx $ server (appDbFile c)) where diff --git a/lib/Parsers/Readwise.hs b/lib/Parsers/Readwise.hs new file mode 100644 index 0000000..0d743c4 --- /dev/null +++ b/lib/Parsers/Readwise.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Parsers.Readwise where + +import Data.Csv +import Data.Text +import Data.Vector (toList) +import Data.ByteString.Lazy (ByteString) +import Api.Types (Quote(..)) + +data RwHighlight = RwHighlight { rhHightlight :: Text + , rhTitle :: Text + , rhAuthor :: Text + , rhBookID :: Text + , rhNote :: Text + , rhColor :: Text + , rhTags :: Text + , rhLocationType :: Text + , rhLocation :: Text + , rhHighlighedAt :: Text + , rhDocumentTags :: Text + } deriving (Show, Eq) + +instance FromNamedRecord RwHighlight where + parseNamedRecord m = RwHighlight <$> m .: "Highlight" + <*> m .: "Book Title" + <*> m .: "Book Author" + <*> m .: "Amazon Book ID" + <*> m .: "Note" + <*> m .: "Color" + <*> m .: "Tags" + <*> m .: "Location Type" + <*> m .: "Location" + <*> m .: "Highlighted at" + <*> m .: "Document tags" + +parseDocument :: ByteString -> [RwHighlight] +parseDocument d = case decodeByName d of + Left _ -> [] + Right (_, va) -> toList va + +parse :: ByteString -> [Quote] +parse d = fmap (\r -> Quote { qQuote = rhHightlight r + , qAuthor = rhAuthor r + , qTitle = rhTitle r + , qPage = rhLocation r + , qChapter = Nothing + , qCreatedOn = Nothing + }) (parseDocument d) diff --git a/quotes-api.cabal b/quotes-api.cabal index ddcdc75..a125f5c 100644 --- a/quotes-api.cabal +++ b/quotes-api.cabal @@ -61,6 +61,7 @@ library -- Modules exported by the library. exposed-modules: Api.Types, Parsers.KOReader, + Parsers.Readwise, Config, -- Modules included in this library but not exported. -- other-modules: @@ -79,6 +80,8 @@ library blaze-markup, blaze-html, optparse-applicative, + cassava, + vector, -- Directories containing source files. hs-source-dirs: lib @@ -111,9 +114,10 @@ executable quotes-api quotes-api, servant-blaze, optparse-applicative, - argon2, + argon2 >= 1.3.0, text-short, bytestring, + QuickCheck, -- Directories containing source files. hs-source-dirs: app diff --git a/shell.nix b/shell.nix index 3773ccd..c1c4ac5 100644 --- a/shell.nix +++ b/shell.nix @@ -1,16 +1,23 @@ -let - pkgs = import { }; # pin the channel to ensure reproducibility! -in -pkgs.haskellPackages.developPackage { - root = ./.; - modifier = drv: - pkgs.haskell.lib.addBuildTools drv (with pkgs.haskellPackages; - [ cabal-install - ghcid - ghc - haskell-language-server - zlib - cabal-plan - ]); -} +{ pkgs ? import {} +}: +pkgs.stdenv.mkDerivation rec { + name = "quotes-api"; + + nativeBuildInputs = [ + ]; + + buildInputs = [ + pkgs.zlib + pkgs.ghc + pkgs.cabal-install + pkgs.haskellPackages.ghcid + pkgs.haskellPackages.cabal-plan + pkgs.haskellPackages.haskell-language-server + ]; + + shellHook = '' + export LD_LIBRARY_PATH=${pkgs.lib.makeLibraryPath buildInputs}:$LD_LIBRARY_PATH + export LANG=en_US.UTF-8 + ''; +}