From d5182778c45704b0a2d5d283a7fca5104588af81 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 30 Oct 2016 10:27:47 +0100 Subject: Org reader: add support for todo-markers Headlines can have optional todo-markers which can be controlled via the `#+TODO`, `#+SEQ_TODO`, or `#+TYP_TODO` meta directive. Multiple such directives can be given, each adding a new set of recognized todo-markers. If no custom todo-markers are defined, the default `TODO` and `DONE` markers are used. Todo-markers are conceptually separate from headline text and are hence excluded when autogenerating headline IDs. The markers are rendered as spans and labelled with two classes: One class is the markers name, the other signals the todo-state of the marker (either `todo` or `done`). --- src/Text/Pandoc/Readers/Org/Blocks.hs | 21 ++++++++++++++- src/Text/Pandoc/Readers/Org/Meta.hs | 43 +++++++++++++++++++++++++++--- src/Text/Pandoc/Readers/Org/ParserState.hs | 39 +++++++++++++++++++++++++++ 3 files changed, 98 insertions(+), 5 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 61978f79f..ead600ccc 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -90,6 +90,7 @@ type Properties = [(PropertyKey, PropertyValue)] -- | Org mode headline (i.e. a document subtree). data Headline = Headline { headlineLevel :: Int + , headlineTodoMarker :: Maybe TodoMarker , headlineText :: Inlines , headlineTags :: [Tag] , headlineProperties :: Properties @@ -107,6 +108,7 @@ headline :: Int -> OrgParser (F Headline) headline lvl = try $ do level <- headerStart guard (lvl <= level) + todoKw <- optionMaybe todoKeyword title <- trimInlinesF . mconcat <$> manyTill inline endOfTitle tags <- option [] headerTags newline @@ -119,6 +121,7 @@ headline lvl = try $ do children' <- sequence children return $ Headline { headlineLevel = level + , headlineTodoMarker = todoKw , headlineText = title' , headlineTags = tags , headlineProperties = properties @@ -193,11 +196,27 @@ headlineToHeaderWithContents hdln@(Headline {..}) = do headlineToHeader :: Headline -> OrgParser Blocks headlineToHeader (Headline {..}) = do - let text = tagTitle headlineText headlineTags + let todoText = case headlineTodoMarker of + Just kw -> todoKeywordToInlines kw <> B.space + Nothing -> mempty + let text = tagTitle (todoText <> headlineText) headlineTags let propAttr = propertiesToAttr headlineProperties attr <- registerHeader propAttr headlineText return $ B.headerWith attr headlineLevel text +todoKeyword :: OrgParser TodoMarker +todoKeyword = try $ do + taskStates <- activeTodoMarkers <$> getState + let kwParser tdm = try $ (tdm <$ string (todoMarkerName tdm) <* spaceChar) + choice (map kwParser taskStates) + +todoKeywordToInlines :: TodoMarker -> Inlines +todoKeywordToInlines tdm = + let todoText = todoMarkerName tdm + todoState = map toLower . show $ todoMarkerState tdm + classes = [todoState, todoText] + in B.spanWith (mempty, classes, mempty) (B.str todoText) + propertiesToAttr :: Properties -> Attr propertiesToAttr properties = let diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs index ea088bfdb..bbbb216a0 100644 --- a/src/Text/Pandoc/Readers/Org/Meta.hs +++ b/src/Text/Pandoc/Readers/Org/Meta.hs @@ -42,11 +42,11 @@ import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder ( Blocks, Inlines ) import Text.Pandoc.Definition -import Control.Monad ( mzero ) +import Control.Monad ( mzero, void ) import Data.Char ( toLower ) import Data.List ( intersperse ) import qualified Data.Map as M -import Data.Monoid ((<>)) +import Data.Monoid ( (<>) ) import Network.HTTP ( urlEncode ) -- | Returns the current meta, respecting export options. @@ -144,8 +144,11 @@ optionLine :: OrgParser () optionLine = try $ do key <- metaKey case key of - "link" -> parseLinkFormat >>= uncurry addLinkFormat - "options" -> exportSettings + "link" -> parseLinkFormat >>= uncurry addLinkFormat + "options" -> exportSettings + "todo" -> todoSequence >>= updateState . registerTodoSequence + "seq_todo" -> todoSequence >>= updateState . registerTodoSequence + "typ_todo" -> todoSequence >>= updateState . registerTodoSequence _ -> mzero addLinkFormat :: String @@ -179,3 +182,35 @@ parseFormat = try $ do inlinesTillNewline :: OrgParser (F Inlines) inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline + +-- +-- ToDo Sequences and Keywords +-- +todoSequence :: OrgParser TodoSequence +todoSequence = try $ do + todoKws <- todoKeywords + doneKws <- optionMaybe $ todoDoneSep *> todoKeywords + newline + -- There must be at least one DONE keyword. The last TODO keyword is taken if + -- necessary. + case doneKws of + Just done -> return $ keywordsToSequence todoKws done + Nothing -> case reverse todoKws of + [] -> mzero -- no keywords present + (x:xs) -> return $ keywordsToSequence (reverse xs) [x] + + where + todoKeywords :: OrgParser [String] + todoKeywords = try $ + let keyword = many1 nonspaceChar <* skipSpaces + endOfKeywords = todoDoneSep <|> void newline + in manyTill keyword (lookAhead endOfKeywords) + + todoDoneSep :: OrgParser () + todoDoneSep = void . try $ skipSpaces *> char '|' <* skipSpaces1 + + keywordsToSequence :: [String] -> [String] -> TodoSequence + keywordsToSequence todo done = + let todoMarkers = map (TodoMarker Todo) todo + doneMarkers = map (TodoMarker Done) done + in todoMarkers ++ doneMarkers diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 84dbe9d33..ef5f89461 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -34,6 +34,11 @@ module Text.Pandoc.Readers.Org.ParserState , OrgNoteRecord , HasReaderOptions (..) , HasQuoteContext (..) + , TodoMarker (..) + , TodoSequence + , TodoState (..) + , activeTodoMarkers + , registerTodoSequence , F(..) , askF , asksF @@ -72,6 +77,20 @@ type OrgNoteTable = [OrgNoteRecord] -- link-type, the corresponding function transforms the given link string. type OrgLinkFormatters = M.Map String (String -> String) +-- | The states in which a todo item can be +data TodoState = Todo | Done + deriving (Eq, Ord, Show) + +-- | A ToDo keyword like @TODO@ or @DONE@. +data TodoMarker = TodoMarker + { todoMarkerState :: TodoState + , todoMarkerName :: String + } + deriving (Show, Eq) + +-- | Collection of todo markers in the order in which items should progress +type TodoSequence = [TodoMarker] + -- | Org-mode parser state data OrgParserState = OrgParserState { orgStateAnchorIds :: [String] @@ -88,6 +107,7 @@ data OrgParserState = OrgParserState , orgStateNotes' :: OrgNoteTable , orgStateOptions :: ReaderOptions , orgStateParserContext :: ParserContext + , orgStateTodoSequences :: [TodoSequence] } data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext } @@ -133,12 +153,31 @@ defaultOrgParserState = OrgParserState , orgStateNotes' = [] , orgStateOptions = def , orgStateParserContext = NullState + , orgStateTodoSequences = [] } optionsToParserState :: ReaderOptions -> OrgParserState optionsToParserState opts = def { orgStateOptions = opts } +registerTodoSequence :: TodoSequence -> OrgParserState -> OrgParserState +registerTodoSequence todoSeq st = + let curSeqs = orgStateTodoSequences st + in st{ orgStateTodoSequences = todoSeq : curSeqs } + +-- | Get the current todo/done sequences. If no custom todo sequences have been +-- defined, return a list containing just the default todo/done sequence. +activeTodoSequences :: OrgParserState -> [TodoSequence] +activeTodoSequences st = + let curSeqs = orgStateTodoSequences st + in if null curSeqs + then [[ TodoMarker Todo "TODO" , TodoMarker Done "DONE" ]] + else curSeqs + +activeTodoMarkers :: OrgParserState -> TodoSequence +activeTodoMarkers = concat . activeTodoSequences + + -- -- Export Settings -- -- cgit v1.2.3