clippings 0.1.2 → 0.1.3
raw patch · 5 files changed
+71/−41 lines, 5 files
Files
- clippings.cabal +6/−1
- src/Data/Functor/Extras.hs +10/−0
- src/Data/String/Extras.hs +12/−0
- src/Text/Kindle/Clippings/Reader.hs +22/−40
- src/Text/Parsec/Combinator/Extras.hs +21/−0
clippings.cabal view
@@ -1,5 +1,5 @@ name: clippings-version: 0.1.2+version: 0.1.3 license: MIT synopsis: A parser/generator for Kindle-format clipping files (`My Clippings.txt`), author: Vikram Verma <me@vikramverma.com>@@ -15,10 +15,15 @@ Text.Kindle.Clippings.Reader Text.Kindle.Clippings.Writer Text.Kindle.Clippings.Types+ other-modules:+ Data.Functor.Extras,+ Data.String.Extras,+ Text.Parsec.Combinator.Extras hs-source-dirs: src build-depends: base,+ bifunctors, time, parsec, old-locale,
+ src/Data/Functor/Extras.hs view
@@ -0,0 +1,10 @@+module Data.Functor.Extras (+ (<$$>),+ for+) where++(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)+(<$$>) = fmap fmap fmap++for :: Functor f => f a -> (a -> b) -> f b+for = flip fmap
+ src/Data/String/Extras.hs view
@@ -0,0 +1,12 @@+module Data.String.Extras (pad, chomp) where++import Data.Char (isSpace)++pad :: (String,String) -> (String,String)+pad (s0,s1) = (s0, pr++s1)+ where pr = take (length s0 - length s1) s0++chomp :: String -> String+chomp = rstrip . lstrip+ where lstrip = dropWhile isSpace+ rstrip = reverse . lstrip . reverse
src/Text/Kindle/Clippings/Reader.hs view
@@ -1,14 +1,17 @@ module Text.Kindle.Clippings.Reader where -import Control.Applicative ((<$>), (<*>), (*>), (<*), (<|>), many)-import Data.Char (isSpace)+import Control.Applicative ((<$>), (<*>), (*>), (<*), (<|>))+import Data.Bifunctor (bimap)+import Data.Functor.Extras ((<$$>),for) import Data.List (find) import Data.Maybe (fromJust, isJust)+import Data.String.Extras (pad, chomp) import Data.Time.LocalTime (LocalTime) import Data.Time.Parse (strptime) import Text.Kindle.Clippings.Types (Clipping(..),Location(..),Document(..),Position(..),Content(..))-import Text.Parsec (many1, digit, alphaNum, string, skipMany, oneOf, noneOf, try, char, manyTill, anyToken, optionMaybe)+import Text.Parsec (many1, digit, alphaNum, string, skipMany, oneOf, try, char, manyTill, anyToken) import Text.Parsec.String (Parser)+import Text.Parsec.Combinator.Extras (but, tryBut1, tryMaybe, tryString) eol :: Parser () eol = skipMany $ oneOf "\n\r"@@ -16,42 +19,27 @@ 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"+readAuthor = tryMaybe $ init + <$> (char '(' *> but "\n\r") readContentType :: Parser String-readContentType = (try (string "- Your ") <|> string "- ")+readContentType = (tryString "- Your " <|> string "- ") *> but " "- <* (try (string " on ") <|> many1 (char ' '))+ <* (tryString " on " <|> many1 (char ' ')) readPageNumber :: Parser (Maybe Int)-readPageNumber = tryMaybe $: read $ string "Page " *> many1 alphaNum <* string " | "+readPageNumber = tryMaybe $ read + <$> (string "Page " *> many1 alphaNum <* string " | ") readLocation :: Parser (Maybe Location) readLocation = tryMaybe - $ (try (string "Loc. ") <|> string "Location ")+ $ (tryString "Loc. " <|> string "Location ") *> (try readLocationRegion <|> readLocationInt) <* but "|" <* char '|' <* many1 (char ' ') @@ -59,22 +47,16 @@ readLocationInt = Location . read <$> many1 digit readLocationRegion :: Parser Location-readLocationRegion = toLocation <$> many1 digit <*> (char '-' *> many1 digit)- where toLocation = parseRegion .: (,)--(.:) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)-(.:) = fmap fmap fmap+readLocationRegion = parseRegion + <$$> (,) + <$> many1 digit + <*> (char '-' *> many1 digit) 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+parseRegion = Region . bimap read read . pad parseDate :: String -> LocalTime-parseDate = fst . fromJust . fromJust {-[^1]-} . find isJust . flip map formats . flip strptime+parseDate = fst . fromJust . fromJust {-[^1]-} . find isJust . for formats . flip strptime where formats = [ "%A, %d %B %y %X" , "%A, %B %d, %Y %r"@@ -83,10 +65,10 @@ -- [^1]: This is safe: `strptime x ""` is `Just` for all `x`. readDate :: Parser LocalTime-readDate = fmap parseDate $ string "Added on " *> but "\n\r"+readDate = parseDate <$> (string "Added on " *> but "\n\r") readContent :: Parser String-readContent = fmap chomp . manyTill anyToken $ try eor+readContent = chomp <$> manyTill anyToken (try eor) readClipping :: Parser (Maybe Clipping) readClipping = clipping@@ -101,7 +83,7 @@ |(==) 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+ |otherwise = Nothing readClippings :: Parser [Maybe Clipping] readClippings = many1 readClipping
+ src/Text/Parsec/Combinator/Extras.hs view
@@ -0,0 +1,21 @@+module Text.Parsec.Combinator.Extras (+ but,+ tryBut1,+ tryMaybe,+ tryString+) where++import Text.Parsec.String (Parser)+import Text.Parsec (many, many1, noneOf, try, optionMaybe, string)++but :: String -> Parser String+but = many . noneOf++tryBut1 :: String -> Parser String+tryBut1 = try . many1 . noneOf++tryMaybe :: Parser a -> Parser (Maybe a)+tryMaybe = optionMaybe . try++tryString :: String -> Parser String+tryString = try . string