WIP: readwise.

This commit is contained in:
Dhananjay Balan 2023-04-11 11:02:42 +02:00
parent b7e88fcfc9
commit e2f7ebe6de
4 changed files with 94 additions and 19 deletions

View File

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

49
lib/Parsers/Readwise.hs Normal file
View File

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

View File

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

View File

@ -1,16 +1,23 @@
let
pkgs = import <unstable> { }; # 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 <unstable> {}
}:
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
'';
}