WIP: readwise.
This commit is contained in:
parent
b7e88fcfc9
commit
e2f7ebe6de
21
app/Main.hs
21
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
|
||||
|
49
lib/Parsers/Readwise.hs
Normal file
49
lib/Parsers/Readwise.hs
Normal 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)
|
@ -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
|
||||
|
||||
|
37
shell.nix
37
shell.nix
@ -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
|
||||
'';
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user