orgmode-parse 0.2.1 → 0.2.2
raw patch · 15 files changed
+79/−78 lines, 15 filesdep +semigroups
Dependencies added: semigroups
Files
- CHANGELOG.md +6/−0
- orgmode-parse.cabal +5/−3
- src/Data/OrgMode/Parse/Attoparsec/Drawer/Generic.hs +1/−3
- src/Data/OrgMode/Parse/Attoparsec/Drawer/Logbook.hs +0/−2
- src/Data/OrgMode/Parse/Attoparsec/Drawer/Property.hs +0/−2
- src/Data/OrgMode/Parse/Attoparsec/Headline.hs +8/−7
- src/Data/OrgMode/Parse/Attoparsec/Section.hs +3/−4
- src/Data/OrgMode/Parse/Attoparsec/Time.hs +19/−23
- src/Data/OrgMode/Parse/Attoparsec/Util.hs +2/−2
- src/Data/OrgMode/Types.hs +6/−4
- test/Document.hs +2/−2
- test/Drawer.hs +4/−4
- test/Headline.hs +10/−10
- test/Timestamps.hs +12/−11
- test/Util.hs +1/−1
CHANGELOG.md view
@@ -1,3 +1,9 @@+0.2.2+- Support building with GHC 8.4.3 (thank you @zhujinxuan!)++0.2.1+- Fix property drawer parsing of :END: delimiter, fixes #35+ 0.2.0 - Fix timestamp parsing in headline and body, fixes #13 - Generalize drawer parser for logbook and generic drawers, fixes #14
orgmode-parse.cabal view
@@ -1,5 +1,5 @@ Name: orgmode-parse-Version: 0.2.1+Version: 0.2.2 Author: Parnell Springmeyer <parnell@digitalmentat.com> Maintainer: Parnell Springmeyer <parnell@digitalmentat.com> License: BSD3@@ -47,7 +47,8 @@ Data.OrgMode.Types Build-Depends:- base >= 4.8 && < 5+ base >= 4.8 && < 5+ , semigroups , aeson >= 0.11 , attoparsec >= 0.13 , bytestring >= 0.10.4@@ -74,8 +75,9 @@ Weekdays Build-Depends:- base >= 4.8 && < 5+ base >= 4.8 && < 5 , orgmode-parse+ , semigroups , aeson >= 0.11 , attoparsec >= 0.13 , bytestring >= 0.10.4
src/Data/OrgMode/Parse/Attoparsec/Drawer/Generic.hs view
@@ -9,7 +9,7 @@ -- Parsing combinators for org-mode section generic drawers. ---------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase #-}+ {-# LANGUAGE OverloadedStrings #-} module Data.OrgMode.Parse.Attoparsec.Drawer.Generic@@ -24,8 +24,6 @@ import Data.Attoparsec.Types as Attoparsec import Data.Text (Text) import qualified Data.Text as Text-import Prelude hiding (concat, null,- takeWhile) import qualified Data.OrgMode.Parse.Attoparsec.Util as Util import Data.OrgMode.Types
src/Data/OrgMode/Parse/Attoparsec/Drawer/Logbook.hs view
@@ -20,8 +20,6 @@ import Data.Attoparsec.Text import Data.Attoparsec.Types as Attoparsec import Data.Text (Text)-import Prelude hiding (concat,- null, takeWhile) import Data.OrgMode.Parse.Attoparsec.Drawer.Generic as Drawer.Generic import Data.OrgMode.Parse.Attoparsec.Time (parseClock)
src/Data/OrgMode/Parse/Attoparsec/Drawer/Property.hs view
@@ -25,8 +25,6 @@ import Data.HashMap.Strict (fromList) import Data.Text (Text) import qualified Data.Text as Text-import Prelude hiding (concat,- null, takeWhile) import Data.OrgMode.Parse.Attoparsec.Drawer.Generic as Drawer.Generic import Data.OrgMode.Types
src/Data/OrgMode/Parse/Attoparsec/Headline.hs view
@@ -9,7 +9,7 @@ -- Parsing combinators for org-mode headlines. ---------------------------------------------------------------------------- -{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} @@ -38,6 +38,7 @@ import qualified Data.OrgMode.Parse.Attoparsec.Time as OrgMode.Time import Data.OrgMode.Parse.Attoparsec.Util import Data.OrgMode.Types+import Data.Functor (($>)) -- | Intermediate type for parsing titles in a headline after the -- state keyword and priority have been parsed.@@ -78,7 +79,7 @@ TitleMeta ( titleText , stats'- , (fromMaybe [] -> tags')+ , fromMaybe [] -> tags' ) <- parseTitle section' <- parseSection@@ -129,7 +130,7 @@ headingPriority = start *> zipChoice <* end where zipChoice = choice (zipWith mkPParser "ABC" [A,B,C])- mkPParser c p = char c *> pure p+ mkPParser c p = char c $> p start = string "[#" end = char ']' @@ -141,8 +142,8 @@ parseTitle = mkTitleMeta <$> titleStart <*>- (optMeta parseStats) <*>- (optMeta parseTags) <*>+ optMeta parseStats <*>+ optMeta parseTags <*> -- Parse what's leftover AND till end of line or input; discarding -- everything but the leftovers leftovers <* (endOfLine <|> endOfInput)@@ -160,7 +161,7 @@ -> Text -- ^ Leftovers (may be empty) of the title -> TitleMeta mkTitleMeta start stats' tags' leftovers =- TitleMeta ((cleanTitle start leftovers), stats', tags')+ TitleMeta (cleanTitle start leftovers, stats', tags') where cleanTitle t l | Text.null leftovers = Text.strip t@@ -185,7 +186,7 @@ parseTags :: Attoparsec.Parser Text [Tag] parseTags = tags' >>= test where- tags' = (char ':' *> takeWhile (/= '\n'))+ tags' = char ':' *> takeWhile (/= '\n') test t | Text.null t = fail "no data after beginning ':'" | Text.last t /= ':' = fail $ Text.unpack $ "expected ':' at end of tag list but got: " `Text.snoc` Text.last t
src/Data/OrgMode/Parse/Attoparsec/Section.hs view
@@ -9,17 +9,16 @@ -- Parsing combinators for org-mode headline sections. ---------------------------------------------------------------------------- -{-# LANGUAGE OverloadedStrings #-} + module Data.OrgMode.Parse.Attoparsec.Section where -import Control.Applicative+import Control.Applicative () import Data.Attoparsec.Text import Data.Attoparsec.Types as Attoparsec-import Data.Monoid+import Data.Monoid () import Data.Text (Text) import qualified Data.Text as Text-import Prelude hiding (unlines) import Data.OrgMode.Parse.Attoparsec.Drawer import Data.OrgMode.Parse.Attoparsec.Time
src/Data/OrgMode/Parse/Attoparsec/Time.hs view
@@ -13,7 +13,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} module Data.OrgMode.Parse.Attoparsec.Time@@ -23,24 +22,22 @@ ) where -import Control.Applicative-import Control.Monad (liftM)+import Control.Applicative import qualified Data.Attoparsec.ByteString as Attoparsec.ByteString import Data.Attoparsec.Combinator as Attoparsec import Data.Attoparsec.Text import Data.Attoparsec.Types as Attoparsec (Parser) import qualified Data.ByteString.Char8 as BS+import Data.Functor (($>)) import Data.HashMap.Strict (HashMap, fromList) import Data.Maybe (listToMaybe)-import Data.Monoid+import Data.Monoid () import Data.Text (Text) import qualified Data.Text as Text import Data.Thyme.Format (buildTime, timeParser) import Data.Thyme.LocalTime (Hours, Minutes)-import Prelude hiding (concat, null, repeat,- takeWhile, unwords, words) import System.Locale (defaultTimeLocale)-+import Data.Semigroup ((<>)) import Data.OrgMode.Types -- | Parse a planning line.@@ -51,12 +48,12 @@ -- -- > DEADLINE: <2015-05-10 17:00> CLOSED: <2015-04-1612:00> parsePlannings :: Attoparsec.Parser Text (HashMap PlanningKeyword Timestamp)-parsePlannings = fromList <$> (many' (skipSpace *> planning <* skipSpace))+parsePlannings = fromList <$> many' (skipSpace *> planning <* skipSpace) where planning = (,) <$> pType <* char ':' <*> (skipSpace *> parseTimestamp)- pType = choice [string "SCHEDULED" *> pure SCHEDULED- ,string "DEADLINE" *> pure DEADLINE- ,string "CLOSED" *> pure CLOSED+ pType = choice [string "SCHEDULED" $> SCHEDULED+ ,string "DEADLINE" $> DEADLINE+ ,string "CLOSED" $> CLOSED ] -- | Parse a clock line.@@ -88,8 +85,7 @@ parseTimestamp = do (ts1, tsb1, act) <- transformBracketedDateTime <$> parseBracketedDateTime - blk2 <- liftM (maybe Nothing (Just . transformBracketedDateTime))- optionalBracketedDateTime+ blk2 <- fmap (fmap transformBracketedDateTime) optionalBracketedDateTime -- TODO: refactor this case logic case (tsb1, blk2) of@@ -220,11 +216,11 @@ -- | Parse the Timeunit part of a delay or repeater flag. parseTimeUnit :: Attoparsec.Parser Text TimeUnit parseTimeUnit =- choice [ char 'h' *> pure UnitHour- , char 'd' *> pure UnitDay- , char 'w' *> pure UnitWeek- , char 'm' *> pure UnitMonth- , char 'y' *> pure UnitYear+ choice [ char 'h' $> UnitHour+ , char 'd' $> UnitDay+ , char 'w' $> UnitWeek+ , char 'm' $> UnitMonth+ , char 'y' $> UnitYear ] -- | Parse a repeater flag, e.g. @.+4w@, or @++1y@.@@ -232,9 +228,9 @@ parseRepeater = Repeater <$> choice- [ string "++" *> pure RepeatCumulate- , char '+' *> pure RepeatCatchUp- , string ".+" *> pure RepeatRestart+ [ string "++" $> RepeatCumulate+ , char '+' $> RepeatCatchUp+ , string ".+" $> RepeatRestart ] <*> decimal <*> parseTimeUnit@@ -244,8 +240,8 @@ parseDelay = Delay <$> choice- [ string "--" *> pure DelayFirst- , char '-' *> pure DelayAll+ [ string "--" $> DelayFirst+ , char '-' $> DelayAll ] <*> decimal <*> parseTimeUnit
src/Data/OrgMode/Parse/Attoparsec/Util.hs view
@@ -19,7 +19,7 @@ import Data.Attoparsec.Types (Parser) import Data.Text (Text) import qualified Data.Text as Text-+import Data.Functor (($>)) -- | Skip whitespace characters, only! --@@ -36,7 +36,7 @@ nonHeadline :: Parser Text Text nonHeadline = nonHeadline0 <|> nonHeadline1 where- nonHeadline0 = Attoparsec.Text.endOfLine *> pure (Text.pack "")+ nonHeadline0 = Attoparsec.Text.endOfLine $> Text.pack "" nonHeadline1 = Text.pack <$> do h <- Attoparsec.Text.notChar '*' t <- Attoparsec.Text.manyTill Attoparsec.Text.anyChar Attoparsec.Text.endOfLine
src/Data/OrgMode/Types.hs view
@@ -52,7 +52,7 @@ import Data.Thyme.Calendar (YearMonthDay (..)) import Data.Thyme.LocalTime (Hour, Hours, Minute, Minutes) import GHC.Generics-+import Data.Semigroup (Semigroup) -- | Org-mode document. data Document = Document { documentText :: Text -- ^ Text occurring before any Org headlines@@ -94,14 +94,16 @@ } deriving (Show, Eq, Generic) newtype Properties = Properties { unProperties :: HashMap Text Text }- deriving (Show, Eq, Generic, Monoid)+ deriving (Show, Eq, Generic, Semigroup, Monoid) + instance Aeson.ToJSON Properties instance Aeson.FromJSON Properties newtype Logbook = Logbook { unLogbook :: [Clock] }- deriving (Show, Eq, Generic, Monoid)+ deriving (Show, Eq, Generic, Semigroup, Monoid) + instance Aeson.ToJSON Logbook instance Aeson.FromJSON Logbook @@ -274,7 +276,7 @@ where jPair (k, v) = pack (show k) .= Aeson.toJSON v instance Aeson.FromJSON Plannings where- parseJSON (Aeson.Object v) = Plns . fromList <$> (traverse jPair (keys v))+ parseJSON (Aeson.Object v) = Plns . fromList <$> traverse jPair (keys v) where jPair k = v .: k parseJSON _ = mzero
test/Document.hs view
@@ -32,10 +32,10 @@ , testCase "Parse Headline no \n" $ testDocS "* T" (Document "" [emptyHeadline {title="T"}]) - , testCase "Parse Document from File" $+ , testCase "Parse Document from File" testDocFile - , testCase "Parse Document with Subtree List Items" $+ , testCase "Parse Document with Subtree List Items" testSubtreeListItemDocFile ]
test/Drawer.hs view
@@ -11,16 +11,16 @@ parserDrawerTests :: TestTree parserDrawerTests = testGroup "Attoparsec PropertyDrawer"- [ testCase "Parse a :PROPERTY: drawer" $+ [ testCase "Parse a :PROPERTY: drawer" testPropertyDrawer - , testCase "Parse empty :PROPERTY: drawer" $+ , testCase "Parse empty :PROPERTY: drawer" (testParser parseProperties ":PROPERTIES:\n:END:\n") - , testCase "Parse a :LOGBOOK: drawer" $+ , testCase "Parse a :LOGBOOK: drawer" testLogbookDrawer - , testCase "Parse a user-defined drawer" $+ , testCase "Parse a user-defined drawer" testGenericDrawer ]
test/Headline.hs view
@@ -11,16 +11,16 @@ parserHeadlineTests :: TestTree parserHeadlineTests = testGroup "Attoparsec Headline"- [ (testCase "Parse Headline Bare" $ testHeadline "* This is a title\n")- , (testCase "Parse Headline Bare with end colon" $ testHeadline "* This heading ends in a colon:")- , (testCase "Parse Headline Bare w/ Depths" $ testHeadline "*** This is a title\n")- , (testCase "Parse Headline w/ Priority" $ testHeadline "* [#A] An important heading\n")- , (testCase "Parse Headline w/ Priority & State" $ testHeadline "* TODO [#A] An important heading with a state indicator\n")- , (testCase "Parse Headline w/ State" $ testHeadline "* CANCELED An important heading with just state\n")- , (testCase "Parse Headline w/ Keywords" $ testHeadline "* An important heading :WITH:KEYWORDS:\n")- , (testCase "Parse Headline Full" $ testHeadline "* DONE [#B] A heading : with [[http://somelink.com][a link]] :WITH:KEYWORDS:\n")- , (testCase "Parse Headline All But Title" $ testHeadline "* DONE [#A] :WITH:KEYWORDS:\n")- , (testCase "Parse Headline w/ Timestamp" $ testHeadline "* TODO [#A] <2017-08-24 22:00> Pickup groceris on\n")+ [ testCase "Parse Headline Bare" $ testHeadline "* This is a title\n"+ , testCase "Parse Headline Bare with end colon" $ testHeadline "* This heading ends in a colon:"+ , testCase "Parse Headline Bare w/ Depths" $ testHeadline "*** This is a title\n"+ , testCase "Parse Headline w/ Priority" $ testHeadline "* [#A] An important heading\n"+ , testCase "Parse Headline w/ Priority & State" $ testHeadline "* TODO [#A] An important heading with a state indicator\n"+ , testCase "Parse Headline w/ State" $ testHeadline "* CANCELED An important heading with just state\n"+ , testCase "Parse Headline w/ Keywords" $ testHeadline "* An important heading :WITH:KEYWORDS:\n"+ , testCase "Parse Headline Full" $ testHeadline "* DONE [#B] A heading : with [[http://somelink.com][a link]] :WITH:KEYWORDS:\n"+ , testCase "Parse Headline All But Title" $ testHeadline "* DONE [#A] :WITH:KEYWORDS:\n"+ , testCase "Parse Headline w/ Timestamp" $ testHeadline "* TODO [#A] <2017-08-24 22:00> Pickup groceris on\n" ] where testHeadline = testParser (headlineBelowDepth ["TODO","CANCELED","DONE"] 0)
test/Timestamps.hs view
@@ -7,6 +7,7 @@ import Data.Attoparsec.Text (endOfLine) import Data.HashMap.Strict import Data.Monoid ((<>))+import Data.Maybe (isNothing) import Data.OrgMode.Parse import qualified Data.Text as T import Test.Tasty@@ -18,33 +19,33 @@ parserPlanningTests :: TestTree parserPlanningTests = testGroup "Attoparsec Planning"- [ (testCase "Parse Planning Schedule" $ testPlanning "SCHEDULED: <2004-02-29 Sun>")- , (testCase "Parse Planning Deadline" $ testPlanning "DEADLINE: <2004-02-29 Sun>")- , (testCase "Parse Planning Full" $ testPlanning "SCHEDULED: <2004-02-29 Sun +1w>")- , (testCase "Parse Sample Schedule" $ testPlanningS sExampleStrA sExampleResA)+ [ testCase "Parse Planning Schedule" $ testPlanning "SCHEDULED: <2004-02-29 Sun>"+ , testCase "Parse Planning Deadline" $ testPlanning "DEADLINE: <2004-02-29 Sun>"+ , testCase "Parse Planning Full" $ testPlanning "SCHEDULED: <2004-02-29 Sun +1w>"+ , testCase "Parse Sample Schedule" $ testPlanningS sExampleStrA sExampleResA ] where- testPlanning t = testParser parsePlannings t+ testPlanning = testParser parsePlannings testPlanningS t r = expectParse parsePlannings t (Right r) (sExampleStrA, sExampleResA) = ("SCHEDULED: <2004-02-29 Sun 10:20 +1w -2d>"- ,(fromList [(SCHEDULED, Timestamp+ ,fromList [(SCHEDULED, Timestamp (DateTime (YearMonthDay 2004 2 29) (Just "Sun") (Just (10,20)) (Just (Repeater RepeatCumulate 1 UnitWeek)) (Just (Delay DelayAll 2 UnitDay))- ) Active Nothing)]))+ ) Active Nothing)]) parserTimestampTests :: TestTree parserTimestampTests = testGroup "Attoparsec Timestamp"- [ (testCase "Parse Timestamp Appointment" $ testTimestamp "<2004-02-29 Sun>\n")- , (testCase "Parse Timestamp Recurring" $ testTimestamp "<2004-02-29 Sun +1w>\n")+ [ testCase "Parse Timestamp Appointment" $ testTimestamp "<2004-02-29 Sun>\n"+ , testCase "Parse Timestamp Recurring" $ testTimestamp "<2004-02-29 Sun +1w>\n" ] where- testTimestamp t = testParser (parseTimestamp <* endOfLine) t+ testTimestamp = testParser (parseTimestamp <* endOfLine) parserWeekdayTests :: TestTree@@ -53,7 +54,7 @@ | (loc,ws) <- weekdays, w <- ws, isOrgParsable w] where dayChars = "]+0123456789>\r\n -" :: String- isOrgParsable w = T.find (\c -> c `elem` dayChars) w == Nothing+ isOrgParsable w = isNothing (T.find (`elem` dayChars) w) mkTest w = expectParse parseTimestamp str (Right res) where str = "<2004-02-29 " <> w <> " 10:20>"
test/Util.hs view
@@ -6,7 +6,7 @@ import Data.Text as T import Test.HUnit -testParser :: (TP.Parser Text a) -> String -> Assertion+testParser :: TP.Parser Text a -> String -> Assertion testParser f v = fromEither (parseOnly f $ T.pack v) expectParse :: (Eq a, Show a) => TP.Parser Text a -- ^ Parser under test