orgmode-parse 0.1.0.3 → 0.1.0.4
raw patch · 7 files changed
+536/−1 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG +13/−0
- orgmode-parse.cabal +6/−1
- src/Data/OrgMode/Parse/Attoparsec/Document.hs +21/−0
- src/Data/OrgMode/Parse/Attoparsec/Headings.hs +163/−0
- src/Data/OrgMode/Parse/Attoparsec/PropertyDrawer.hs +59/−0
- src/Data/OrgMode/Parse/Attoparsec/Section.hs +40/−0
- src/Data/OrgMode/Parse/Attoparsec/Time.hs +234/−0
CHANGELOG view
@@ -1,6 +1,19 @@ -*- mode: org -*- * Changelog+** 0.1.0.4+*** Miscellany+ - Comment improvement wibbles.+ - Adding the =Attoparsec= combinator modules to the export module+ list in the cabal package definition.+** 0.1.0.3+*** Features+ - Sub-headings are now parsed and tracked by its parent.+ - Much more robust timestamp / clock / schedule parsing.++*** Miscellany+ - A good mount of code cleanup and comment improvement.+ ** 0.0.2.1 *** Bugfixes - [X] Fixing the import for the =Internal= module (instead of
orgmode-parse.cabal view
@@ -1,5 +1,5 @@ Name: orgmode-parse-Version: 0.1.0.3+Version: 0.1.0.4 Author: Parnell Springmeyer <parnell@digitalmentat.com> Maintainer: Parnell Springmeyer <parnell@digitalmentat.com> License: BSD3@@ -36,6 +36,11 @@ Exposed-Modules: Data.OrgMode.Parse Data.OrgMode.Parse.Types+ Data.OrgMode.Parse.Attoparsec.Document+ Data.OrgMode.Parse.Attoparsec.Headings+ Data.OrgMode.Parse.Attoparsec.PropertyDrawer+ Data.OrgMode.Parse.Attoparsec.Section+ Data.OrgMode.Parse.Attoparsec.Time Build-Depends: base >= 4.4 && < 5
+ src/Data/OrgMode/Parse/Attoparsec/Document.hs view
@@ -0,0 +1,21 @@+module Data.OrgMode.Parse.Attoparsec.Document (+ parseDocument+) where++import Control.Applicative ((<$>), (<*>))+import Data.Attoparsec.Text+import Data.Attoparsec.Types as TP+import Prelude hiding (unlines)+import Data.Text (Text, pack, unlines)+import Data.OrgMode.Parse.Types+import Data.OrgMode.Parse.Attoparsec.Headings++------------------------------------------------------------------------------+parseDocument :: [Text] -> TP.Parser Text Document+parseDocument otherKeywords =+ Document+ <$> (unlines <$> many' nonHeaderLine)+ <*> many' (headingBelowLevel otherKeywords 0)++nonHeaderLine :: TP.Parser Text Text+nonHeaderLine = pack <$> manyTill (notChar '*') endOfLine
+ src/Data/OrgMode/Parse/Attoparsec/Headings.hs view
@@ -0,0 +1,163 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.OrgMode.Parse.Attoparsec.Headings+-- Copyright : © 2014 Parnell Springmeyer+-- License : All Rights Reserved+-- Maintainer : Parnell Springmeyer <parnell@digitalmentat.com>+-- Stability : stable+--+-- Parsing combinators for org-list headings.+----------------------------------------------------------------------------++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++module Data.OrgMode.Parse.Attoparsec.Headings+( headingBelowLevel+, headingLevel+, headingPriority+, parseStats+, parseTags+)+where++import Control.Applicative (pure, (*>), (<$>), (<*),+ (<*>), (<|>))+import Control.Monad (liftM5, void)+import Data.Attoparsec.Text as T+import Data.Attoparsec.Types as TP (Parser)+import Data.Maybe (fromMaybe)+import Data.Monoid (mempty)+import Data.Text as Text (Text, append,+ init, last,+ length, null,+ splitOn, strip)+import Prelude hiding (concat, null,+ sequence_, takeWhile,+ unlines)+import Text.Printf++import Data.OrgMode.Parse.Attoparsec.Section+import Data.OrgMode.Parse.Types+++-- | Parse an org-mode heading and its contained entities (see <http://orgmode.org/worg/dev/org-syntax.html OrgSyntax>).+--+-- Headers include a hierarchy level indicated by asterisks, optional+-- todo states, priority level, %-done stats, and tags.+--+-- > ** TODO [#B] Polish Poetry Essay [25%] :HOMEWORK:POLISH:WRITING:+--+-- Headings may contain:+--+-- - A section with Planning and Clock entries+-- - A number of other not-yet-implemented entities (code blocks, lists)+-- - Unstructured text+-- - Other heading deeper in the hierarchy+--+-- 'headingBelowLevel' takes a list of terms to consider, state+-- keywords, and a minumum hierarchy depth. Use 0 to parse any+-- heading.+headingBelowLevel :: [Text] -> LevelDepth -> TP.Parser Text Heading+headingBelowLevel stateKeywords depth = do+ lvl <- headingLevel depth <* skipSpace'+ td <- option Nothing (Just <$> parseStateKeyword stateKeywords <* skipSpace')+ pr <- option Nothing (Just <$> headingPriority <* skipSpace')++ TitleMeta tl stats' (fromMaybe [] -> tags') <- takeTitleExtras++ sect <- parseSection+ subs <- option [] $ many' (headingBelowLevel stateKeywords (depth + 1))++ skipSpace++ return $ Heading lvl td pr tl stats' tags' sect subs++-- | Parse the asterisk indicated heading level until a space is+-- reached.+--+-- Constrain it to LevelDepth or its children.+headingLevel :: LevelDepth -> TP.Parser Text Level+headingLevel (LevelDepth d) = takeLevel >>= test+ where+ takeLevel = Text.length <$> takeWhile1 (== '*')+ test l | l <= d = fail $ printf "Heading level of %d cannot be higher than depth %d" l d+ | otherwise = return $ Level l++-- | Parse the state indicator.+--+-- > {`TODO` | `DONE` | custom }+--+-- These can be custom so we're parsing additional state identifiers+-- as Text.+parseStateKeyword :: [Text] -> TP.Parser Text StateKeyword+parseStateKeyword (map string -> sk) = StateKeyword <$> choice sk++-- | Parse the priority indicator.+--+-- If anything but these priority indicators are used the parser will+-- fail:+--+-- - @[#A]@+-- - @[#B]@+-- - @[#C]@+headingPriority :: TP.Parser Text Priority+headingPriority = start *> zipChoice <* end+ where+ zipChoice = choice (zipWith mkPParser "ABC" [A,B,C])+ mkPParser c p = char c *> pure p+ start = string "[#"+ end = char ']'++-- | Parse the title, optional stats block, and optional tag.+--+-- Stats may be either [m/n] or [n%] and tags are colon-separated, e.g:+-- > :HOMEWORK:POETRY:WRITING:+takeTitleExtras :: TP.Parser Text TitleMeta+takeTitleExtras =+ liftM5 mkTitleMeta+ titleStart+ (optionalMetadata parseStats)+ (optionalMetadata parseTags)+ leftovers+ (void $ endOfLine <|> endOfInput)+ where+ titleStart = takeTill (\c -> inClass "[:" c || isEndOfLine c)+ leftovers = option mempty $ takeTill (== '\n')+ optionalMetadata p = option Nothing (Just <$> p <* skipSpace')+++mkTitleMeta :: Text -> Maybe Stats -> Maybe [Tag] -> Text -> () -> TitleMeta+mkTitleMeta start stats' tags' leftovers _ =+ TitleMeta (transformTitle start leftovers) stats' tags'+ where+ transformTitle t l | null leftovers = strip t+ | otherwise = append t l++-- | Parse a stats block.+--+-- Accepts either form: "[m/n]" or "[n%]" and there is no restriction+-- on m or n other than that they are integers.+parseStats :: TP.Parser Text Stats+parseStats = sPct <|> sOf+ where sPct = StatsPct+ <$> (char '[' *> decimal <* string "%]")+ sOf = StatsOf+ <$> (char '[' *> decimal)+ <*> (char '/' *> decimal <* char ']')++-- | Parse a colon-separated list of Tags+--+-- > :HOMEWORK:POETRY:WRITING:+parseTags :: TP.Parser Text [Tag]+parseTags = tags' >>= test+ where+ tags' = (char ':' *> takeWhile (/= '\n'))+ test t | (Text.last t /= ':' || Text.length t < 2) = fail "Not a valid tag set"+ | otherwise = return (splitOn ":" (Text.init t))++skipSpace' :: TP.Parser Text ()+skipSpace' = void $ takeWhile spacePred+ where+ spacePred s = s == ' ' || s == '\t'
+ src/Data/OrgMode/Parse/Attoparsec/PropertyDrawer.hs view
@@ -0,0 +1,59 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.OrgMode.Parse.Attoparsec.PropertyDrawer+-- Copyright : © 2014 Parnell Springmeyer+-- License : All Rights Reserved+-- Maintainer : Parnell Springmeyer <parnell@digitalmentat.com>+-- Stability : stable+--+-- Parsing combinators for org-mode entry property drawers.+----------------------------------------------------------------------------++{-# LANGUAGE OverloadedStrings #-}+++module Data.OrgMode.Parse.Attoparsec.PropertyDrawer+( parseDrawer+, property+)+where++import Control.Applicative ((*>), (<*))+import Data.Attoparsec.Text as T+import Data.Attoparsec.Types as TP+import Data.HashMap.Strict (fromList)+import Data.Text as Text (Text, strip)+import Prelude hiding (concat, null, takeWhile)++import Data.OrgMode.Parse.Types++type PropertyKey = Text+type PropertyVal = Text++-- | Parse a property drawer.+--+-- > :PROPERTIES:+-- > :DATE: [2014-12-14 11:00]+-- > :NOTE: Something really crazy happened today!+-- > :END:+parseDrawer :: TP.Parser Text Properties+parseDrawer = return . fromList =<< begin *> manyTill property end+ where+ begin = ident "PROPERTIES"+ end = ident "END"+ ident v = skipSpace *> skip (== ':') *>+ asciiCI v <*+ skip (== ':') <* skipSpace++-- | Parse a property of a drawer.+--+-- Properties *must* be a `:KEY: value` pair, the key can be of any+-- case and contain any characters except for newlines and colons+-- (since they delimit the start and end of the key).+property :: TP.Parser Text (PropertyKey, PropertyVal)+property = do+ key <- skipSpace *> skip (== ':') *> takeWhile1 (/= ':') <* skip (== ':')+ val <- skipSpace *> takeValue+ return (key, strip val)+ where+ takeValue = takeWhile1 (not . isEndOfLine)
+ src/Data/OrgMode/Parse/Attoparsec/Section.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.OrgMode.Parse.Attoparsec.Section+-- Copyright : © 2015 Parnell Springmeyer+-- License : All Rights Reserved+-- Maintainer : Parnell Springmeyer <parnell@digitalmentat.com>+-- Stability : stable+--+-- Parsing combinators for org-mode sections.+----------------------------------------------------------------------------++{-# LANGUAGE OverloadedStrings #-}++module Data.OrgMode.Parse.Attoparsec.Section where++import Control.Applicative ((<$>), (<*>))+import Data.Attoparsec.Text as T+import Data.Attoparsec.Types as TP+import Data.Monoid (mempty)+import Data.Text (Text, pack,+ unlines)+import Prelude hiding (unlines)++import Data.OrgMode.Parse.Attoparsec.PropertyDrawer+import Data.OrgMode.Parse.Attoparsec.Time+import Data.OrgMode.Parse.Types++-- | Parse a heading section+--+-- Heading sections contain optionally a property drawer,+-- a list of clock entries, code blocks (not yet implemented),+-- plain lists (not yet implemented), and unstructured text.+parseSection :: TP.Parser Text Section+parseSection = Section+ <$> (Plns <$> parsePlannings)+ <*> many' parseClock+ <*> option mempty parseDrawer+ <*> (unlines <$> many' nonHeaderLine)+ where+ nonHeaderLine = pack <$> manyTill (notChar '*') endOfLine
+ src/Data/OrgMode/Parse/Attoparsec/Time.hs view
@@ -0,0 +1,234 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.OrgMode.Parse.Attoparsec.Time+-- Copyright : © 2014 Parnell Springmeyer+-- License : All Rights Reserved+-- Maintainer : Parnell Springmeyer <parnell@digitalmentat.com>+-- Stability : stable+--+-- Parsing combinators for org-mode active and inactive timestamps.+----------------------------------------------------------------------------++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.OrgMode.Parse.Attoparsec.Time where++import Control.Applicative (pure, (*>), (<$>), (<*), (<*>),+ (<|>))+import Control.Monad (liftM)+import qualified Data.Attoparsec.ByteString as AB+import Data.Attoparsec.Text as T+import Data.Attoparsec.Types as TP (Parser)+import qualified Data.ByteString.Char8 as BS+import Data.HashMap.Strict (HashMap, fromList)+import Data.Maybe (listToMaybe)+import Data.Text as Text (Text, pack, unpack,+ unwords)+import Data.Thyme.Format (buildTime, timeParser)+import Data.Thyme.LocalTime (Hours, Minutes)+import Prelude hiding (concat, null, takeWhile,+ unwords, words)+import System.Locale (defaultTimeLocale)++import Data.OrgMode.Parse.Types++-- | Parse a planning line.+--+-- Plannings inhabit a heading section and are formatted as a keyword+-- and a timestamp. There can be more than one, but they are all on+-- the same line e.g:+--+-- > DEADLINE: <2015-05-10 17:00> CLOSED: <2015-04-1612:00>+parsePlannings :: TP.Parser Text (HashMap PlanningKeyword Timestamp)+parsePlannings = fromList <$> (many' (planning <* skipSpace))+ where planning :: TP.Parser Text (PlanningKeyword, Timestamp)+ planning = (,) <$> pType <* char ':' <*> (skipSpace *> parseTimestamp)+ pType = choice [string "SCHEDULED" *> pure SCHEDULED+ ,string "DEADLINE" *> pure DEADLINE+ ,string "CLOSED" *> pure CLOSED+ ]++-- | Parse a clock line.+--+-- A heading's section contains one line per clock entry. Clocks may+-- have a timestamp, a duration, both, or neither e.g.:+--+-- > CLOCK: [2014-12-10 Fri 2:30]--[2014-12-10 Fri 10:30] => 08:00+parseClock :: TP.Parser Text (Maybe Timestamp, Maybe Duration)+parseClock = (,) <$> (skipSpace *> string "CLOCK: " *> ts) <*> dur+ where+ ts = option Nothing (Just <$> parseTimestamp)+ dur = option Nothing (Just <$> (string " => "+ *> skipSpace *> parseHM))++-- | Parse a timestamp.+--+-- Timestamps may be timepoints or timeranges, and they indicate+-- whether they are active or closed by using angle or square brackets+-- respectively.+--+-- Time ranges are formatted by infixing two timepoints with a double+-- hyphen, @--@; or, by appending two @hh:mm@ timestamps together in a+-- single timepoint with one hyphen @-@.+--+-- Each timepoint includes an optional repeater flag and an optional+-- delay flag.+parseTimestamp :: TP.Parser Text Timestamp+parseTimestamp = do+ (ts1, tsb1, act) <- transformBracketedDateTime <$> parseBracketedDateTime++ -- Such ew, so gross, much clean, very needed+ blk2 <- liftM (maybe Nothing (Just . transformBracketedDateTime))+ optionalBracketedDateTime++ -- TODO: this is grody, I'd like to refactor this truth table logic+ -- and make the transformations chainable and composable as opposed+ -- to depending on case matching blocks. - Parnell+ case (tsb1, blk2) of+ (Nothing, Nothing) ->+ return (Timestamp ts1 act Nothing)+ (Nothing, Just (ts2, Nothing, _)) ->+ return (Timestamp ts1 act (Just ts2))+ (Nothing, Just _) ->+ fail "Illegal time range in second timerange timestamp"+ (Just (h',m'), Nothing) ->+ return (Timestamp ts1 act+ (Just $ ts1 {hourMinute = Just (h',m')+ ,repeater = Nothing+ ,delay = Nothing}))+ (Just _, Just _) -> fail "Illegal mix of time range and timestamp range"++ where+ optionalBracketedDateTime =+ option Nothing (Just <$> (string "--" *> parseBracketedDateTime))++type Weekday = Text++data BracketedDateTime =+ BracketedDateTime+ { datePart :: YearMonthDay+ , dayNamePart :: Maybe Weekday+ , timePart :: Maybe TimePart+ , repeat :: Maybe Repeater+ , delayPart :: Maybe Delay+ , isActive :: Bool+ } deriving (Show, Eq)++-- | Parse a single time part.+--+-- > [2015-03-27 Fri 10:20 +4h]+--+-- Returns:+--+-- - The basic timestamp+-- - Whether there was a time interval in place of a single time+-- (this will be handled upstream by parseTimestamp)+-- - Whether the time is active or inactive+parseBracketedDateTime :: TP.Parser Text BracketedDateTime+parseBracketedDateTime = do+ openingBracket <- char '<' <|> char '['+ brkDateTime <- BracketedDateTime <$>+ parseDate <* skipSpace+ <*> optionalParse parseDay+ <*> optionalParse parseTime'+ <*> maybeListParse parseRepeater+ <*> maybeListParse parseDelay+ <*> pure (activeBracket openingBracket)++ closingBracket <- char '>' <|> char ']'+ finally brkDateTime openingBracket closingBracket+ where+ optionalParse p = option Nothing (Just <$> p) <* skipSpace+ maybeListParse p = listToMaybe <$> many' p <* skipSpace+ activeBracket = (=='<')++ finally bkd ob cb | complementaryBracket ob /= cb =+ fail "Mismatched timestamp brackets"+ | otherwise = return bkd++ complementaryBracket '<' = '>'+ complementaryBracket '[' = ']'+ complementaryBracket x = x++-- TODO: this function is also grody but it's better than having this+-- logic in the primary parseBracketedDateTime function. - Parnell+transformBracketedDateTime :: BracketedDateTime -> (DateTime, Maybe (Hours, Minutes), Bool)+transformBracketedDateTime+ (BracketedDateTime dp dn tp rp dly act) =+ case tp of+ Just (TimePart (Left (h,m))) ->+ ( DateTime (YMD' dp) dn (Just (h,m)) rp dly+ , Nothing+ , act)+ Just (TimePart (Right (t1, t2))) ->+ ( DateTime (YMD' dp) dn (Just t1) rp dly+ , Just t2+ , act)+ Nothing ->+ ( DateTime (YMD' dp) dn Nothing rp dly+ , Nothing+ , act)++-- | Parse a 3-character day name.+parseDay :: TP.Parser Text Text+parseDay = choice (map string ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"])++type AbsoluteTime = (Hours, Minutes)+type TimestampRange = (AbsoluteTime, AbsoluteTime)++newtype TimePart = TimePart (Either AbsoluteTime TimestampRange)+ deriving (Eq, Ord, Show)++-- | Parse the time-of-day part of a time part, as a single point or a+-- time range.+parseTime' :: TP.Parser Text TimePart+parseTime' =+ TimePart <$> choice [ Right <$> ((,) <$> parseHM <* char '-' <*> parseHM)+ , Left <$> parseHM+ ]++-- | Parse the YYYY-MM-DD part of a time part.+parseDate :: TP.Parser Text YearMonthDay+parseDate = consumeDate >>= either failure success . dateParse+ where+ failure e = fail . unpack $ unwords ["Failure parsing date: ", pack e]+ success t = return $ buildTime t+ consumeDate = manyTill anyChar (char ' ')+ dateParse = AB.parseOnly dpCombinator . BS.pack+ dpCombinator = timeParser defaultTimeLocale "%Y-%m-%d"++-- | Parse a single @HH:MM@ point.+parseHM :: TP.Parser Text (Hours, Minutes)+parseHM = (,) <$> decimal <* char ':' <*> decimal++-- | Parse the Timeunit part of a delay or repeater flag.+parseTimeUnit :: TP.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+ ]++-- | Parse a repeater flag, e.g. @.+4w@, or @++1y@.+parseRepeater :: TP.Parser Text Repeater+parseRepeater =+ Repeater+ <$> choice[ string "++" *> pure RepeatCumulate+ , char '+' *> pure RepeatCatchUp+ , string ".+" *> pure RepeatRestart+ ]+ <*> decimal+ <*> parseTimeUnit++-- | Parse a delay flag, e.g. @--1d@ or @-2w@.+parseDelay :: TP.Parser Text Delay+parseDelay =+ Delay+ <$> choice [ string "--" *> pure DelayFirst+ , char '-' *> pure DelayAll+ ]+ <*> decimal+ <*> parseTimeUnit