WIP: readwise.

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

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)

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
 

shell.nix

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