clippings (empty) → 0.1.1
raw patch · 12 files changed
+411/−0 lines, 12 filesdep +ansi-terminaldep +assertdep +assertionssetup-changed
Dependencies added: ansi-terminal, assert, assertions, base, bytestring, cassava, clippings, data-default, filepath, old-locale, parsec, safecopy, strptime, time
Files
- LICENSE +21/−0
- Setup.hs +3/−0
- clippings.cabal +51/−0
- examples/clippings2tsv/Main.hs +45/−0
- src/Text/Kindle/Clippings.hs +9/−0
- src/Text/Kindle/Clippings/Reader.hs +108/−0
- src/Text/Kindle/Clippings/Types.hs +58/−0
- src/Text/Kindle/Clippings/Writer.hs +54/−0
- tests/Reader.hs +47/−0
- tests/fixtures/brackets.txt +5/−0
- tests/fixtures/clipping.txt +5/−0
- tests/fixtures/nested_brackets.txt +5/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) Vikram Verma++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple (defaultMain)++main = defaultMain
+ clippings.cabal view
@@ -0,0 +1,51 @@+name: clippings+version: 0.1.1+license-file: LICENSE+license: MIT+synopsis: A parser/generator for Kindle-format clipping files (`My Clippings.txt`),+author: Vikram Verma <me@vikramverma.com>+maintainer: Vikram Verma <me@vikramverma.com>+data-files: tests/fixtures/brackets.txt, tests/fixtures/clipping.txt, tests/fixtures/nested_brackets.txt+category: Text+build-type: Simple+cabal-version: >=1.10++library+ exposed-modules: Text.Kindle.Clippings Text.Kindle.Clippings.Reader Text.Kindle.Clippings.Writer Text.Kindle.Clippings.Types+ hs-source-dirs: src+ build-depends: + base,+ time,+ parsec,+ old-locale,+ strptime,+ ansi-terminal,+ data-default,+ assert+ default-language: Haskell2010++test-suite wright-tests+ type: exitcode-stdio-1.0+ main-is: Reader.hs+ hs-source-dirs: tests+ build-depends: base == 2.*,+ clippings,+ data-default,+ parsec,+ time,+ old-locale,+ assertions,+ filepath+ other-modules: Paths_clippings+ default-language: Haskell2010++executable clippings2tsv+ main-is: Main.hs+ hs-source-dirs: examples/clippings2tsv+ build-depends: base == 2.*, + clippings, + cassava, + parsec, + bytestring,+ safecopy+ default-language: Haskell2010
+ examples/clippings2tsv/Main.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE RecordWildCards, LambdaCase #-}++module Main where++import Prelude hiding (putStr)+import Control.Applicative ((<$>))+import Control.Applicative.Extras ((<$$>))+import Data.ByteString.Lazy (ByteString)+import Data.ByteString.Lazy.Char8 (putStr)+import Data.Card (Card(..), ToCard(..))+import Data.Csv.Extras (encodeTabDelimited) +import Data.Either.Extras (bimapEither)+import Data.List.Extras (substitute)+import Data.Maybe (fromMaybe, catMaybes)+import Data.Monoid ((<>), Monoid (mempty))+import System.Environment (getArgs)+import System.Exit (exitSuccess, exitFailure)+import System.IO (hPutStr, stderr)+import Text.Kindle.Clippings (Clipping(..), Document(..), Content(..), readClippings)+import Text.Parsec (parse)++instance ToCard Clipping where+ toCard c@Clipping{..} + | not (isHighlight c) = Nothing+ | null (show content) = Nothing+ | otherwise = Just $ Card content' author'+ where author' = fromMaybe "[clippings2tsv]" $ (" - " <>) <$> author document+ content' = substitute '\n' ' ' $ show content++isHighlight :: Clipping -> Bool+isHighlight Clipping{..} = case content of+ Highlight _ -> True+ _ -> False++getClippings :: String -> Either String [Clipping]+getClippings = bimapEither show catMaybes + . parse readClippings [] ++renderClippings :: [Clipping] -> ByteString+renderClippings = encodeTabDelimited . catMaybes . fmap toCard++main :: IO ()+main = head <$> getArgs >>= getClippings <$$> readFile >>= \case+ Left err -> hPutStr stderr err >> exitFailure+ Right cs -> putStr (renderClippings cs) >> exitSuccess
+ src/Text/Kindle/Clippings.hs view
@@ -0,0 +1,9 @@+module Text.Kindle.Clippings +( module Text.Kindle.Clippings.Types+, module Text.Kindle.Clippings.Reader+, module Text.Kindle.Clippings.Writer+) where++import Text.Kindle.Clippings.Types+import Text.Kindle.Clippings.Reader+import Text.Kindle.Clippings.Writer
+ src/Text/Kindle/Clippings/Reader.hs view
@@ -0,0 +1,108 @@+module Text.Kindle.Clippings.Reader where++import Text.Parsec hiding ((<|>), many)+import Text.Parsec.String+import Data.Char (isSpace)+import Data.Time.LocalTime (LocalTime)+import Text.Kindle.Clippings.Types +import Data.Default+import Control.Applicative +import Data.Time.LocalTime (LocalTime)+import Data.Time.Parse (strptime)+import Data.Maybe (fromMaybe)++eol :: Parser ()+eol = skipMany $ oneOf "\n\r"++eor :: Parser String+eor = string "=========="++chomp :: String -> String+chomp = rstrip . lstrip+ where lstrip = dropWhile isSpace+ rstrip = reverse . lstrip . reverse++but :: String -> Parser String+but = many . noneOf++tryBut1 :: String -> Parser String+tryBut1 = try . many1 . noneOf++readTitle :: Parser String+readTitle = chomp . concat <$> textAndBrackets+ where brackets = (\a b c -> a:(concat b)++c) <$> char '(' <*> textAndBrackets <*> string ") "+ textAndBrackets = many1 (tryBut1 "(\r\n)" <|> try brackets)++tryMaybe :: Parser a -> Parser (Maybe a)+tryMaybe = optionMaybe . try++($:) :: Functor f => (f a -> b) -> (c -> a) -> f c -> b+f0 $: f1 = fmap f0 (fmap f1)++readAuthor :: Parser (Maybe String)+readAuthor = tryMaybe $: init $ char '(' *> but "\n\r"++readContentType :: Parser String+readContentType = string "- " *> but " " <* string " "++readPageNumber :: Parser (Maybe Int)+readPageNumber = tryMaybe $: read $ string "on Page " *> many1 alphaNum <* string " | "++readLocation :: Parser (Maybe Location)+readLocation = tryMaybe $ string "Loc. " *> readLocation' <* but "|" <* string "| "++readLocation' :: Parser Location+readLocation' = (try readLocationRegion) <|> readLocationInt++readLocationInt :: Parser Location+readLocationInt = Location . read <$> many1 digit++(.:) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)+(.:) = fmap fmap fmap++readLocationRegion :: Parser Location+readLocationRegion = toLocation <$> many1 digit <*> (char '-' *> many1 digit)+ where toLocation = parseRegion .: (,)++parseRegion :: (String, String) -> Location+parseRegion (s0,s1) = Region . readTuple $ pad (s0,s1)+ where readTuple (s2,s3) = (read s2, read s3) ++pad :: (String,String) -> (String,String)+pad (s0,s1) = (s0, pr++s1)+ where pr = take (length s0 - length s1) s0++parseDate :: String -> LocalTime+parseDate = fromMaybe def . fmap fst . strptime "%A, %d %B %y %X"++readDate :: Parser LocalTime+readDate = fmap parseDate $ string "Added on " *> but "\n\r"++readContent :: Parser String+readContent = do+ content <- manyTill anyToken $ try $ string "=========="+ return $ chomp content++readClipping :: Parser (Maybe Clipping)+readClipping = do+ title <- readTitle+ author <- readAuthor+ eol+ typ <- readContentType+ page <- readPageNumber+ loc <- readLocation+ date <- readDate+ eol+ content <- readContent+ eol+ return $ clipping typ (Document title author) (Position page loc) date content++clipping :: String -> Document -> Position -> LocalTime -> String -> Maybe Clipping+clipping t d p l c+ |(==) t "Highlight" = Just $ Clipping d p l $ Highlight c+ |(==) t "Note" = Just $ Clipping d p l $ Annotation c+ |(==) t "Bookmark" = Just $ Clipping d p l Bookmark+ | otherwise = Nothing++readClippings :: Parser [Maybe Clipping]+readClippings = many1 readClipping
+ src/Text/Kindle/Clippings/Types.hs view
@@ -0,0 +1,58 @@+module Text.Kindle.Clippings.Types +( Clipping (..)+, Document (..)+, Position (..)+, Location (..)+, Content (..)+) where++import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..))+import Data.Time.Calendar (fromGregorian)+import Data.Default++data Clipping = Clipping+ { document :: Document+ , position :: Position+ , date :: LocalTime+ , content :: Content+ } deriving (Eq)++data Document = Document + { title :: String+ , author :: Maybe String -- Not always present, e.g. "Oxford Dictionary of English\n".+ } deriving (Eq)++data Position = Position+ { page :: Maybe Int+ , location :: Maybe Location -- PDFs don't get these.+ } deriving (Eq)++data Location = Location Int | Region (Int,Int)++instance Eq Location where+ Location a == Location b = a==b+ Region a == Region b = a==b+ _ == _ = False++data Content = Bookmark | Highlight String | Annotation String++instance Eq Content where + Bookmark == Bookmark = True+ Highlight s0 == Highlight s1 = s0 == s1+ Annotation s0 == Annotation s1 = s0 == s1+ _ == _ = False++instance Default Document where+ def = Document [] Nothing++instance Default Position where+ def = Position Nothing Nothing++instance Default LocalTime where+ def = LocalTime (fromGregorian 1970 1 1) (TimeOfDay 0 0 0)++instance Default Content where+ def = Bookmark++instance Default Clipping where+ def = Clipping def def def def
+ src/Text/Kindle/Clippings/Writer.hs view
@@ -0,0 +1,54 @@+module Text.Kindle.Clippings.Writer +( showClipping+, showClippings+) where++import Data.Time.LocalTime (LocalTime)+import Data.Time.Format (formatTime, readTime)+import System.Locale (defaultTimeLocale)+import Text.Kindle.Clippings.Types++instance Show Document where+ show (Document title (Just author)) = title ++ " (" ++ author ++ ")"+ show (Document title (Nothing)) = title++instance Show Position where+ show (Position Nothing (Just l)) = show l+ show (Position Nothing Nothing) = ""+ show (Position (Just p) (Just l)) = "on Page " ++ show p ++ " | " ++ show l+ show (Position (Just p) Nothing) = "on Page " ++ show p ++instance Show Content where+ show (Highlight s) = s+ show (Annotation s) = s+ show (Bookmark) = ""++instance Show Location where+ show (Location i) = "Loc. " ++ show i+ show (Region (l1,l2)) = "Loc. " ++ show l1 ++ "-" ++ show l2++showContentType :: Content -> String+showContentType (Highlight _) = "Highlight"+showContentType (Annotation _) = "Note"+showContentType (Bookmark) = "Bookmark"++showKindleDate :: LocalTime -> String+showKindleDate = formatTime defaultTimeLocale "%A, %d %B %y %X"++showClipping :: Clipping -> String+showClipping c = unlines $+ [ show (document c)+ , "- " ++ showType c ++ " " ++ showPosition c ++ " | Added on " ++ showDate c+ , ""+ , showContent c+ , "=========="+ ] where showPosition = show . position + showDate = showKindleDate . date + showContent = show . content + showType = showContentType . content++instance Show Clipping where+ show = showClipping++showClippings :: [Clipping] -> String+showClippings = concat . map showClipping
+ tests/Reader.hs view
@@ -0,0 +1,47 @@+import Data.Monoid ((<>))+import Control.Applicative ((<$>))+import System.FilePath (splitFileName)+import System.Environment (getExecutablePath)+import Text.Kindle.Clippings.Types+import Text.Kindle.Clippings.Reader (readClipping)+import Text.Parsec (parse)+import Data.Maybe (fromMaybe)+import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..))+import Data.Time.Calendar (fromGregorian)+import Test.Assert (runAssertions)+import Data.Default+import Paths_clippings (getDataFileName)++fromMaybeEither :: Default b => Either a (Maybe b) -> b+fromMaybeEither = fromMaybe def .$ either (Just . const def) id+ +(.$) :: (b -> c) -> (a -> b) -> a -> c+(.$) = ((.) $)++getClipping :: String -> Clipping+getClipping a = fromMaybeEither $ parse readClipping "tests/Reader.hs" a++inFixture :: Clipping+inFixture = Clipping + { date = LocalTime (fromGregorian 2013 06 10) (TimeOfDay 6 58 17)+ , document = Document "Haskell Monoids and their Uses" (Just "sigfpe")+ , position = Position Nothing . Just $ Region (3,4)+ , content = Highlight "Haskell is a great language for constructing code modularly from small but orthogonal building blocks."+ }++getTitle :: Clipping -> String+getTitle = title . document++getAuthor :: Clipping -> Maybe String+getAuthor = author . document+ +main :: IO () +main = do+ clipping <- readFile =<< getDataFileName "tests/fixtures/clipping.txt"+ brackets <- readFile =<< getDataFileName "tests/fixtures/brackets.txt"+ nested <- readFile =<< getDataFileName "tests/fixtures/nested_brackets.txt"+ runAssertions $ + [ ("Fixture should parse to sigfpe clipping.", getClipping clipping == inFixture)+ , ("Brackets in clippings' titles should be preserved." , getTitle (getClipping brackets) == "An Introduction to Statistical Learning: with Applications in R (Springer Texts in Statistics)")+ , ("Nested brackets in clippings' authors should be preserved.", getAuthor (getClipping nested) == Just "G. K. (Gilbert Keith) Chesterton")+ ]
+ tests/fixtures/brackets.txt view
@@ -0,0 +1,5 @@+An Introduction to Statistical Learning: with Applications in R (Springer Texts in Statistics) (Gareth James, Daniela Witten, Trevor Hastie and Robert Tibshirani)+- Highlight Loc. 1109-12 | Added on Tuesday, 25 February 14 01:17:01 GMT+07:54++There is no free lunch in statistics: no one method dominates all others over all possible data sets. On a particular data set, one specific method may work best, but some other method may work better on a similar but different data set. Hence it is an important task to decide for any given set of data which method produces the best results. Selecting the best approach can be one of the most challenging parts of performing statistical learning in practice. +==========
+ tests/fixtures/clipping.txt view
@@ -0,0 +1,5 @@+Haskell Monoids and their Uses (sigfpe) +- Highlight Loc. 3-4 | Added on Monday, 10 June 13 06:58:17 GMT+08:00 + +Haskell is a great language for constructing code modularly from small but orthogonal building blocks. +==========
+ tests/fixtures/nested_brackets.txt view
@@ -0,0 +1,5 @@+Orthodoxy (G. K. (Gilbert Keith) Chesterton)+- Highlight on Page 5 | Loc. 82-84 | Added on Tuesday, 11 December 12 23:29:20 GMT+08:00++These essays are concerned only to discuss the actual fact that the central Christian theology (sufficiently summarized in the Apostles' Creed) is the best root of energy and sound ethics. +==========