diff --git a/LICENSE b/LICENSE deleted file mode 100644 --- a/LICENSE +++ /dev/null @@ -1,21 +0,0 @@ -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. diff --git a/clippings.cabal b/clippings.cabal --- a/clippings.cabal +++ b/clippings.cabal @@ -1,6 +1,5 @@ name: clippings -version: 0.1.1 -license-file: LICENSE +version: 0.1.2 license: MIT synopsis: A parser/generator for Kindle-format clipping files (`My Clippings.txt`), author: Vikram Verma @@ -11,41 +10,62 @@ 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: + 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 + data-default + default-language: + Haskell2010 + ghc-options: + -Wall -fno-warn-orphans -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 +test-suite clippings-tests + type: + exitcode-stdio-1.0 + main-is: + Reader.hs + hs-source-dirs: + tests + build-depends: + base == 4.*, + clippings, + data-default, + parsec, + time, + old-locale, + assertions, + filepath + other-modules: + Paths_clippings + default-language: + Haskell2010 + ghc-options: + -Wall -fno-warn-orphans executable clippings2tsv - main-is: Main.hs - hs-source-dirs: examples/clippings2tsv - build-depends: base == 2.*, - clippings, - cassava, - parsec, - bytestring, - safecopy - default-language: Haskell2010 + main-is: + Main.hs + hs-source-dirs: + examples/clippings2tsv + build-depends: + base == 4.*, + bifunctors, + clippings, + cassava, + parsec, + bytestring, + safecopy + default-language: + Haskell2010 + ghc-options: + -Wall -fno-warn-orphans diff --git a/examples/clippings2tsv/Main.hs b/examples/clippings2tsv/Main.hs --- a/examples/clippings2tsv/Main.hs +++ b/examples/clippings2tsv/Main.hs @@ -5,14 +5,14 @@ import Prelude hiding (putStr) import Control.Applicative ((<$>)) import Control.Applicative.Extras ((<$$>)) +import Data.Bifunctor (Bifunctor(bimap)) 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 Data.Monoid ((<>)) import System.Environment (getArgs) import System.Exit (exitSuccess, exitFailure) import System.IO (hPutStr, stderr) @@ -33,7 +33,7 @@ _ -> False getClippings :: String -> Either String [Clipping] -getClippings = bimapEither show catMaybes +getClippings = bimap show catMaybes . parse readClippings [] renderClippings :: [Clipping] -> ByteString diff --git a/src/Text/Kindle/Clippings/Reader.hs b/src/Text/Kindle/Clippings/Reader.hs --- a/src/Text/Kindle/Clippings/Reader.hs +++ b/src/Text/Kindle/Clippings/Reader.hs @@ -1,15 +1,14 @@ module Text.Kindle.Clippings.Reader where -import Text.Parsec hiding ((<|>), many) -import Text.Parsec.String +import Control.Applicative ((<$>), (<*>), (*>), (<*), (<|>), many) import Data.Char (isSpace) -import Data.Time.LocalTime (LocalTime) -import Text.Kindle.Clippings.Types -import Data.Default -import Control.Applicative +import Data.List (find) +import Data.Maybe (fromJust, isJust) import Data.Time.LocalTime (LocalTime) import Data.Time.Parse (strptime) -import Data.Maybe (fromMaybe) +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.String (Parser) eol :: Parser () eol = skipMany $ oneOf "\n\r" @@ -43,27 +42,29 @@ readAuthor = tryMaybe $: init $ char '(' *> but "\n\r" readContentType :: Parser String -readContentType = string "- " *> but " " <* string " " +readContentType = (try (string "- Your ") <|> string "- ") + *> but " " + <* (try (string " on ") <|> many1 (char ' ')) readPageNumber :: Parser (Maybe Int) -readPageNumber = tryMaybe $: read $ string "on Page " *> many1 alphaNum <* string " | " +readPageNumber = tryMaybe $: read $ string "Page " *> many1 alphaNum <* string " | " readLocation :: Parser (Maybe Location) -readLocation = tryMaybe $ string "Loc. " *> readLocation' <* but "|" <* string "| " - -readLocation' :: Parser Location -readLocation' = (try readLocationRegion) <|> readLocationInt +readLocation = tryMaybe + $ (try (string "Loc. ") <|> string "Location ") + *> (try readLocationRegion <|> readLocationInt) + <* but "|" <* char '|' <* many1 (char ' ') 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 .: (,) +(.:) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) +(.:) = fmap fmap fmap + parseRegion :: (String, String) -> Location parseRegion (s0,s1) = Region . readTuple $ pad (s0,s1) where readTuple (s2,s3) = (read s2, read s3) @@ -73,32 +74,30 @@ where pr = take (length s0 - length s1) s0 parseDate :: String -> LocalTime -parseDate = fromMaybe def . fmap fst . strptime "%A, %d %B %y %X" +parseDate = fst . fromJust . fromJust {-[^1]-} . find isJust . flip map formats . flip strptime + where formats = + [ "%A, %d %B %y %X" + , "%A, %B %d, %Y %r" + , "" + ] +-- [^1]: This is safe: `strptime x ""` is `Just` for all `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 +readContent = fmap chomp . manyTill anyToken $ try eor 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 +readClipping = clipping + <$> (Document <$> readTitle <*> readAuthor <* eol) + <*> readContentType + <*> (Position <$> readPageNumber <*> readLocation) + <*> readDate <* eol + <*> readContent <* eol -clipping :: String -> Document -> Position -> LocalTime -> String -> Maybe Clipping -clipping t d p l c +clipping :: Document -> String -> Position -> LocalTime -> String -> Maybe Clipping +clipping d t 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 diff --git a/src/Text/Kindle/Clippings/Writer.hs b/src/Text/Kindle/Clippings/Writer.hs --- a/src/Text/Kindle/Clippings/Writer.hs +++ b/src/Text/Kindle/Clippings/Writer.hs @@ -3,14 +3,14 @@ , showClippings ) where +import Data.Time.Format (formatTime) import Data.Time.LocalTime (LocalTime) -import Data.Time.Format (formatTime, readTime) import System.Locale (defaultTimeLocale) -import Text.Kindle.Clippings.Types +import Text.Kindle.Clippings.Types (Clipping(..), Document(..), Position(..), Content(..), Location(..)) instance Show Document where - show (Document title (Just author)) = title ++ " (" ++ author ++ ")" - show (Document title (Nothing)) = title + show (Document t (Just a)) = t ++ " (" ++ a ++ ")" + show (Document t Nothing) = t instance Show Position where show (Position Nothing (Just l)) = show l diff --git a/tests/Reader.hs b/tests/Reader.hs --- a/tests/Reader.hs +++ b/tests/Reader.hs @@ -1,16 +1,14 @@ -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 Control.Monad ((<=<)) +import Data.Default (Default(def)) import Data.Maybe (fromMaybe) -import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..)) import Data.Time.Calendar (fromGregorian) -import Test.Assert (runAssertions) -import Data.Default +import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..)) import Paths_clippings (getDataFileName) +import Test.Assert (runAssertions) +import Text.Kindle.Clippings.Reader (readClipping) +import Text.Kindle.Clippings.Types (Clipping(..),Location(..),Document(..),Position(..),Content(..)) +import Text.Kindle.Clippings.Writer () +import Text.Parsec (parse) fromMaybeEither :: Default b => Either a (Maybe b) -> b fromMaybeEither = fromMaybe def .$ either (Just . const def) id @@ -19,7 +17,7 @@ (.$) = ((.) $) getClipping :: String -> Clipping -getClipping a = fromMaybeEither $ parse readClipping "tests/Reader.hs" a +getClipping = fromMaybeEither . parse readClipping "tests/Reader.hs" inFixture :: Clipping inFixture = Clipping @@ -29,6 +27,14 @@ , content = Highlight "Haskell is a great language for constructing code modularly from small but orthogonal building blocks." } +inPw2Fixture :: Clipping +inPw2Fixture = Clipping + { date = LocalTime (fromGregorian 2014 06 08) (TimeOfDay 20 36 53) + , document = Document "Stand on Zanzibar" (Just "John Brunner") + , position = Position Nothing . Just $ Region (4607, 4607) + , content = Highlight "Shinka will" + } + getTitle :: Clipping -> String getTitle = title . document @@ -37,11 +43,15 @@ 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" + [clipping, brackets, nested, pw2] <- mapM (readFile <=< getDataFileName) + [ "tests/fixtures/clipping.txt" + , "tests/fixtures/brackets.txt" + , "tests/fixtures/nested_brackets.txt" + , "tests/fixtures/pw2clipping.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") + , ("Pw2Fixture should parse to Zanzibar clipping", getClipping pw2 == inPw2Fixture) ]