orgmode-parse-0.2.3: src/Data/OrgMode/Parse/Attoparsec/Time.hs
-----------------------------------------------------------------------------
-- |
-- 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 timestamps; both active and
-- inactive.
----------------------------------------------------------------------------
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Data.OrgMode.Parse.Attoparsec.Time
( parsePlannings
, parseClock
, parseTimestamp
)
where
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 qualified Data.OrgMode.Parse.Attoparsec.Util as Util
import Data.OrgMode.Types
import Data.Semigroup ((<>))
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 (repeat)
import System.Locale (defaultTimeLocale)
-- | 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 :: Attoparsec.Parser Text (HashMap PlanningKeyword Timestamp)
parsePlannings = fromList <$> many' (skipSpace *> planning <* Util.skipOnlySpace)
where
planning = (,) <$> pType <* char ':' <*> (skipSpace *> parseTimestamp)
pType = choice [string "SCHEDULED" $> SCHEDULED
,string "DEADLINE" $> DEADLINE
,string "CLOSED" $> 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 :: Attoparsec.Parser Text Clock
parseClock = Clock <$> ((,) <$> (skipSpace *> string "CLOCK: " *> ts) <*> dur)
where
ts = optional parseTimestamp
dur = optional (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 :: Attoparsec.Parser Text Timestamp
parseTimestamp = do
(ts1, tsb1, act) <- transformBracketedDateTime <$> parseBracketedDateTime
blk2 <- fmap (fmap transformBracketedDateTime) optionalBracketedDateTime
-- TODO: refactor this case logic
case (tsb1, blk2) of
(Nothing, Nothing) ->
pure (Timestamp ts1 act Nothing)
(Nothing, Just (ts2, Nothing, _)) ->
pure (Timestamp ts1 act (Just ts2))
(Nothing, Just _) ->
-- TODO: improve error message with an example of what would
-- cause this case
fail "Illegal time range in second timerange timestamp"
(Just (h',m'), Nothing) ->
pure (Timestamp ts1 act
(Just $ ts1 {hourMinute = Just (h',m')
,repeater = Nothing
,delay = Nothing}))
(Just _, Just _) ->
-- TODO: improve error message with an example of what would
-- cause thise case
fail "Illegal mix of time range and timestamp range"
where
optionalBracketedDateTime =
optional (string "--" *> parseBracketedDateTime)
-- | 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 :: Attoparsec.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 = optional p <* skipSpace
maybeListParse p = listToMaybe <$> many' p <* skipSpace
activeBracket ((=='<') -> active) =
if active then Active else Inactive
finally bkd ob cb | complementaryBracket ob /= cb =
-- TODO: improve this error message with an
-- example of what would cause this case
fail "mismatched timestamp brackets"
| otherwise = return bkd
complementaryBracket '<' = '>'
complementaryBracket '[' = ']'
complementaryBracket x = x
-- | Given a @BracketedDateTime@ data type, transform it into a triple
-- composed of a @DateTime@, possibly a @(Hours, Minutes)@ tuple
-- signifying the end of a timestamp range, and a boolean indic
transformBracketedDateTime :: BracketedDateTime
-> (DateTime, Maybe (Hours, Minutes), ActiveState)
transformBracketedDateTime BracketedDateTime{..} =
maybe dateStamp timeStamp timePart
where
defdt = DateTime datePart dayNamePart Nothing repeat delayPart
timeStamp (AbsoluteTime (hs,ms)) =
( defdt { hourMinute = Just (hs,ms) }
, Nothing
, activeState
)
timeStamp (TimeStampRange (t0,t1)) =
( defdt { hourMinute = Just t0 }
, Just t1
, activeState
)
dateStamp = (defdt, Nothing, activeState)
-- | Parse a day name in the same way as org-mode does.
--
-- The character set (@]+0123456789>\r\n -@) is based on a part of a
-- regexp named @org-ts-regexp0@ found in org.el.
parseDay :: Attoparsec.Parser Text Text
parseDay = Text.pack <$> some (Attoparsec.satisfyElem isDayChar)
where
isDayChar :: Char -> Bool
isDayChar = (`notElem` nonDayChars)
-- | This is based on: @[^]+0-9>\r\n -]+@, a part of a regexp
-- named org-ts-regexp0 in org.el.
nonDayChars = "]+0123456789>\r\n -" :: String
-- | Parse the time-of-day part of a time part, as a single point or a
-- time range.
parseTime' :: Attoparsec.Parser Text TimePart
parseTime' = stampRng <|> stampAbs
where
stampRng = do
beg <- parseHM <* char '-'
end <- parseHM
pure $ TimeStampRange (beg,end)
stampAbs = AbsoluteTime <$> parseHM
-- | Parse the YYYY-MM-DD part of a time part.
parseDate :: Attoparsec.Parser Text YearMonthDay
parseDate = consumeDate >>= either bad good . dateParse
where
bad e = fail $ "failure parsing date: " <> e
good t = pure $ buildTime t
consumeDate = manyTill anyChar $ char ' '
dateParse = Attoparsec.ByteString.parseOnly dpCombinator . BS.pack
dpCombinator = timeParser defaultTimeLocale "%Y-%m-%d"
-- | Parse a single @HH:MM@ point.
parseHM :: Attoparsec.Parser Text (Hours, Minutes)
parseHM = (,) <$> decimal <* char ':' <*> decimal
-- | Parse the Timeunit part of a delay or repeater flag.
parseTimeUnit :: Attoparsec.Parser Text TimeUnit
parseTimeUnit =
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@.
parseRepeater :: Attoparsec.Parser Text Repeater
parseRepeater =
Repeater
<$> choice
[ string "++" $> RepeatCumulate
, char '+' $> RepeatCatchUp
, string ".+" $> RepeatRestart
]
<*> decimal
<*> parseTimeUnit
-- | Parse a delay flag, e.g. @--1d@ or @-2w@.
parseDelay :: Attoparsec.Parser Text Delay
parseDelay =
Delay
<$> choice
[ string "--" $> DelayFirst
, char '-' $> DelayAll
]
<*> decimal
<*> parseTimeUnit