diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/orgmode-parse.cabal b/orgmode-parse.cabal --- a/orgmode-parse.cabal +++ b/orgmode-parse.cabal @@ -1,5 +1,5 @@ Name: orgmode-parse -Version: 0.2.1 +Version: 0.2.2 Author: Parnell Springmeyer Maintainer: Parnell Springmeyer 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 diff --git a/src/Data/OrgMode/Parse/Attoparsec/Drawer/Generic.hs b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Generic.hs --- a/src/Data/OrgMode/Parse/Attoparsec/Drawer/Generic.hs +++ b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Generic.hs @@ -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 diff --git a/src/Data/OrgMode/Parse/Attoparsec/Drawer/Logbook.hs b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Logbook.hs --- a/src/Data/OrgMode/Parse/Attoparsec/Drawer/Logbook.hs +++ b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Logbook.hs @@ -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) diff --git a/src/Data/OrgMode/Parse/Attoparsec/Drawer/Property.hs b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Property.hs --- a/src/Data/OrgMode/Parse/Attoparsec/Drawer/Property.hs +++ b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Property.hs @@ -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 diff --git a/src/Data/OrgMode/Parse/Attoparsec/Headline.hs b/src/Data/OrgMode/Parse/Attoparsec/Headline.hs --- a/src/Data/OrgMode/Parse/Attoparsec/Headline.hs +++ b/src/Data/OrgMode/Parse/Attoparsec/Headline.hs @@ -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 diff --git a/src/Data/OrgMode/Parse/Attoparsec/Section.hs b/src/Data/OrgMode/Parse/Attoparsec/Section.hs --- a/src/Data/OrgMode/Parse/Attoparsec/Section.hs +++ b/src/Data/OrgMode/Parse/Attoparsec/Section.hs @@ -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 diff --git a/src/Data/OrgMode/Parse/Attoparsec/Time.hs b/src/Data/OrgMode/Parse/Attoparsec/Time.hs --- a/src/Data/OrgMode/Parse/Attoparsec/Time.hs +++ b/src/Data/OrgMode/Parse/Attoparsec/Time.hs @@ -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 diff --git a/src/Data/OrgMode/Parse/Attoparsec/Util.hs b/src/Data/OrgMode/Parse/Attoparsec/Util.hs --- a/src/Data/OrgMode/Parse/Attoparsec/Util.hs +++ b/src/Data/OrgMode/Parse/Attoparsec/Util.hs @@ -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 diff --git a/src/Data/OrgMode/Types.hs b/src/Data/OrgMode/Types.hs --- a/src/Data/OrgMode/Types.hs +++ b/src/Data/OrgMode/Types.hs @@ -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 diff --git a/test/Document.hs b/test/Document.hs --- a/test/Document.hs +++ b/test/Document.hs @@ -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 ] diff --git a/test/Drawer.hs b/test/Drawer.hs --- a/test/Drawer.hs +++ b/test/Drawer.hs @@ -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 ] diff --git a/test/Headline.hs b/test/Headline.hs --- a/test/Headline.hs +++ b/test/Headline.hs @@ -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) diff --git a/test/Timestamps.hs b/test/Timestamps.hs --- a/test/Timestamps.hs +++ b/test/Timestamps.hs @@ -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>" diff --git a/test/Util.hs b/test/Util.hs --- a/test/Util.hs +++ b/test/Util.hs @@ -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