WIP: readwise.
This commit is contained in:
		
							
								
								
									
										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 | ||||
|   ''; | ||||
| } | ||||
|   | ||||
		Reference in New Issue
	
	Block a user
	 Dhananjay Balan
					Dhananjay Balan