diff --git a/CHANGELOG b/CHANGELOG deleted file mode 100644 --- a/CHANGELOG +++ /dev/null @@ -1,35 +0,0 @@ --*- mode: org -*- - -* Changelog -** 0.1.1.0 -*** Bugfixes - - The weekday parser now correctly parses weekday appellations of - other languages (thank you nushio3!) using a combinator-style - version of the regex found in org-mode. -** 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 - re-exporting it in each parser module). -** 0.0.2.0 -*** Features - - [X] Added parsers for the scheduled / deadline timestamps. -** 0.0.1.1 -*** Features - - [X] Parsing of property drawer. - - [X] Tests for both drawer and heading parsers. -** 0.0.0.2 -*** Features - - [X] Parsers for orgmode list headlines. diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,33 @@ +0.2.0 +- Fix timestamp parsing in headline and body, fixes #13 +- Generalize drawer parser for logbook and generic drawers, fixes #14 +- Reorganize the types, fixes #15 + +0.1.1.0 +- The weekday parser now correctly parses weekday appellations of other + languages (thank you nushio3!) using a combinator-style version of the regex + found in org-mode. + +0.1.0.4 +- Comment improvement wibbles. +- Adding the =Attoparsec= combinator modules to the export module list in the + cabal package definition. + +0.1.0.3 +- Sub-headings are now parsed and tracked by its parent. +- Much more robust timestamp / clock / schedule parsing. +- A good mount of code cleanup and comment improvement. + +0.0.2.1 +- [X] Fixing the import for the =Internal= module (instead of re-exporting it in + each parser module). + +0.0.2.0 +- [X] Added parsers for the scheduled / deadline timestamps. + +0.0.1.1 +- [X] Parsing of property drawer. +- [X] Tests for both drawer and heading parsers. + +0.0.0.2 +- [X] Parsers for orgmode list headlines. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,67 @@ +# Welcome! +![Hackage Version](https://img.shields.io/hackage/v/orgmode-parse.svg?style=flat) +![Travis CI Status](https://travis-ci.org/ixmatus/orgmode-parse.svg?branch=master) + +`orgmode-parse` provides a top-level parser and collection of attoparsec parser +combinators for org-mode structured text. + +- [What's Finished](#whats-finished) +- [What's Planned](#whats-planned) +- [Building](#building) + +## What's Finished +We have built attoparsec parsers for parsing org-mode document structures and +meta-data. Here is a list of all the syntax features that have a complete +parsing implementation and not: + +- [X] Headlines + - [X] State keywords + - [X] Priority indicator + - [X] Title + - [X] Status / progress indicator + - [X] Tag list +- [X] Property drawers +- [X] State keyword changelogs +- [X] Scheduled and deadline timestamps (timestamp, range, duration, periodicity) + - [X] Active and inactive timestamps +- [X] Clock timestamps +- [ ] Markup + - [ ] Emphasis + - [ ] Bold + - [ ] Italic + - [ ] Strikethrough + - [ ] Underline + - [ ] Superscript + - [ ] Subscript + - [ ] Code / monospaced + - [ ] Tables + - [ ] Lists + - [ ] Unordered lists + - [ ] Numbered lists + - [ ] Checkbox modified lists + - [ ] Blocks (src / quote / example blocks) + +Parsing org-mode markup is currently being worked on. + +## What's Planned (outside of what's not finished) +1. Modernizing this library and adding significantly more documentation to it +2. Writing a sister library, `orgmode-pretty`, providing a pretty printer + implementation for an org-mode AST +3. Pandoc integration + +## Building +There are a few ways to build this library if you're developing a patch: + +- `stack build && stack test`, and +- `nix-build --no-out-link --attr orgmode-parse release.nix` + +You can also use the `nix-shell` provided cabal environment for incremental +development: + +```shell +$ nix-shell --attr orgmode-parse.env release.nix +$ cabal build +``` + +# License +[BSD3 Open Source Software License](https://github.com/digitalmentat/orgmode-parse/blob/master/LICENSE) diff --git a/README.org b/README.org deleted file mode 100644 --- a/README.org +++ /dev/null @@ -1,44 +0,0 @@ -* Welcome! - [[https://hackage.haskell.org/package/orgmode-parse][https://img.shields.io/hackage/v/orgmode-parse.svg?style=flat]] - [[https://travis-ci.org/digitalmentat/orgmode-parse][https://travis-ci.org/digitalmentat/orgmode-parse.svg?branch=master]] - - This is a reference implementation of an [[https://github.com/digitalmentat/orgmode-grammar/blob/master/SPECIFICATION.org][orgmode-grammar]] parser in - Haskell. - -** What's Finished - We have built attoparsec parsers for parsing org-mode document - structures and meta-data. Here is a list of all the syntax features - that have a complete parsing implementation and not: - - - [X] Headings - - [X] State keywords - - [X] Priority indicator - - [X] Title - - [X] Status / progress indicator - - [X] Tag list - - [X] Property drawers - - [X] State keyword changelogs - - [X] Scheduled and deadline timestamps (timestamp, range, - duration, periodicity) - - [X] Active and inactive timestamps - - [X] Clock timestamps - - [ ] Markup - - [ ] Emphasis - - [ ] Bold - - [ ] Italic - - [ ] Strikethrough - - [ ] Underline - - [ ] Superscript - - [ ] Subscript - - [ ] Code / monospaced - - [ ] Tables - - [ ] Lists - - [ ] Unordered lists - - [ ] Numbered lists - - [ ] Checkbox modified lists - - [ ] Blocks (src / quote / example blocks) - - Org-mode markup is currently being worked on. - -* License - [[https://github.com/digitalmentat/orgmode-parse/blob/master/LICENSE][BSD3 Open Source Software License]] diff --git a/TODO.org b/TODO.org deleted file mode 100644 --- a/TODO.org +++ /dev/null @@ -1,15 +0,0 @@ --*- mode: org -*- - -Please place stray thought TODOs in here. - -* Enhance the Weekday Parser test. - At the moment, parserWeekdayTests for some locales are not - supported, because in such locales the weekdays strings - - - contain characters that are not lexically correct as Haskell strings. - - contain digits, which should also be rejected by emacs org-mode's parser. - - see test/Weekdays.hs and test/Timestamps.hs . - - Current test for parserWeekdayTests skips such cases. Whether or how - to support such locales are future work. 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.1.1.3 +Version: 0.2.0 Author: Parnell Springmeyer Maintainer: Parnell Springmeyer License: BSD3 @@ -9,7 +9,7 @@ flavored documents. Description: - <> + <> . `orgmode-parse` is a parsing library for the org-mode flavor of document markup. @@ -23,9 +23,8 @@ Extra-Source-Files: LICENSE - README.org - TODO.org - CHANGELOG + CHANGELOG.md + README.md Library Default-Language: Haskell2010 @@ -34,26 +33,30 @@ -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-orphans -fno-warn-unused-do-bind 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 + Data.OrgMode.Parse, + Data.OrgMode.Parse.Attoparsec.Document, + Data.OrgMode.Parse.Attoparsec.Headline, + Data.OrgMode.Parse.Attoparsec.Drawer, + Data.OrgMode.Parse.Attoparsec.Drawer.Logbook, + Data.OrgMode.Parse.Attoparsec.Drawer.Property, + Data.OrgMode.Parse.Attoparsec.Drawer.Generic, + Data.OrgMode.Parse.Attoparsec.Section, + Data.OrgMode.Parse.Attoparsec.Time, + Data.OrgMode.Parse.Attoparsec.Util, + Data.OrgMode.Types Build-Depends: - base >= 4.4 && < 5 - , aeson >= 0.8.0.2 - , attoparsec >= 0.12 + base >= 4.8 && < 5 + , aeson >= 0.11 + , attoparsec >= 0.13 , bytestring >= 0.10.4 - , containers >= 0.5.5 + , containers >= 0.5.6 , free >= 4.9 , hashable >= 1.2 , old-locale >= 1.0 - , text >= 1.0 + , text >= 1.2 , thyme >= 0.3 - , unordered-containers >= 0.2 + , unordered-containers >= 0.2.7 Test-Suite tests Type: exitcode-stdio-1.0 @@ -62,22 +65,30 @@ Ghc-Options: -Wall Main-Is: Test.hs Other-Modules: - Data.OrgMode.Parse + Document, + Headline, + Drawer, + Timestamps, + Util, + Weekdays Build-Depends: - base >= 4.4 - , aeson >= 0.8 - , bytestring >= 0.10 - , text >= 1.0 - , attoparsec >= 0.12 - , hashable >= 1.2 - , unordered-containers >= 0.2 - , thyme >= 0.3 - , old-locale >= 1.0 - , HUnit >= 1.2.5.2 - , tasty >= 0.8 - , tasty-hunit >= 0.8.0.1 - , containers + base >= 4.8 && < 5 + , orgmode-parse + , aeson >= 0.11 + , attoparsec >= 0.13 + , bytestring >= 0.10.4 + , containers >= 0.5.6 + , free >= 4.9 + , hashable >= 1.2 + , old-locale >= 1.0 + , text >= 1.2 + , thyme >= 0.3 + , unordered-containers >= 0.2.7 + , HUnit >= 1.3 + , tasty >= 0.11 + , tasty-hunit >= 0.9 + , neat-interpolation >= 0.3 Source-Repository head Type: git diff --git a/src/Data/OrgMode/Parse.hs b/src/Data/OrgMode/Parse.hs --- a/src/Data/OrgMode/Parse.hs +++ b/src/Data/OrgMode/Parse.hs @@ -1,11 +1,11 @@ {-| -Module : Data.OrgMode.Parse.Attoparsec.Headings +Module : Data.OrgMode.Parse Copyright : © 2014 Parnell Springmeyer License : All Rights Reserved Maintainer : Parnell Springmeyer Stability : stable -Attoparsec combinators for orgmode documents. +Attoparsec combinators for parsing org-mode documents. -} module Data.OrgMode.Parse ( @@ -13,30 +13,21 @@ -- * Parse OrgMode documents module Data.OrgMode.Parse.Attoparsec.Document --- * OrgMode Document structure -, module Data.OrgMode.Parse.Types - -- * Parse headlines -, module Data.OrgMode.Parse.Attoparsec.Headings +, module Data.OrgMode.Parse.Attoparsec.Headline -- * Parse headline metadata sections , module Data.OrgMode.Parse.Attoparsec.Section --- * Parse metadata property drawers -, module Data.OrgMode.Parse.Attoparsec.PropertyDrawer +-- * Parse drawers +, module Data.OrgMode.Parse.Attoparsec.Drawer -- * Parse metadata timestamps and modifiers , module Data.OrgMode.Parse.Attoparsec.Time ) where -import Data.OrgMode.Parse.Attoparsec.Document - -import Data.OrgMode.Parse.Attoparsec.Section - -import Data.OrgMode.Parse.Attoparsec.Headings - -import Data.OrgMode.Parse.Attoparsec.PropertyDrawer - -import Data.OrgMode.Parse.Attoparsec.Time - -import Data.OrgMode.Parse.Types +import Data.OrgMode.Parse.Attoparsec.Document +import Data.OrgMode.Parse.Attoparsec.Drawer +import Data.OrgMode.Parse.Attoparsec.Headline +import Data.OrgMode.Parse.Attoparsec.Section +import Data.OrgMode.Parse.Attoparsec.Time diff --git a/src/Data/OrgMode/Parse/Attoparsec/Document.hs b/src/Data/OrgMode/Parse/Attoparsec/Document.hs --- a/src/Data/OrgMode/Parse/Attoparsec/Document.hs +++ b/src/Data/OrgMode/Parse/Attoparsec/Document.hs @@ -1,19 +1,32 @@ -module Data.OrgMode.Parse.Attoparsec.Document ( - parseDocument -) where +----------------------------------------------------------------------------- +-- | +-- Module : Data.OrgMode.Parse.Attoparsec.Document +-- Copyright : © 2014 Parnell Springmeyer +-- License : All Rights Reserved +-- Maintainer : Parnell Springmeyer +-- Stability : stable +-- +-- Top-level attoparsec parser for org-mode documents. +---------------------------------------------------------------------------- +module Data.OrgMode.Parse.Attoparsec.Document +( parseDocument +) +where + import Control.Applicative ((<$>), (<*>)) import Data.Attoparsec.Text -import Data.Attoparsec.Types as TP -import Data.OrgMode.Parse.Attoparsec.Headings -import Data.OrgMode.Parse.Attoparsec.Section (nonHeaderLine) -import Data.OrgMode.Parse.Types -import Data.Text (Text, unlines) -import Prelude hiding (unlines) +import Data.Attoparsec.Types as Attoparsec +import Data.Text (Text) +import qualified Data.Text as Text +import Data.OrgMode.Parse.Attoparsec.Headline +import qualified Data.OrgMode.Parse.Attoparsec.Util as Util +import Data.OrgMode.Types + ------------------------------------------------------------------------------ -parseDocument :: [Text] -> TP.Parser Text Document +parseDocument :: [Text] -> Attoparsec.Parser Text Document parseDocument otherKeywords = Document - <$> (unlines <$> many' nonHeaderLine) - <*> many' (headingBelowLevel otherKeywords 0) + <$> (Text.unlines <$> many' Util.nonHeadline) + <*> many' (headlineBelowDepth otherKeywords 0) diff --git a/src/Data/OrgMode/Parse/Attoparsec/Drawer.hs b/src/Data/OrgMode/Parse/Attoparsec/Drawer.hs new file mode 100644 --- /dev/null +++ b/src/Data/OrgMode/Parse/Attoparsec/Drawer.hs @@ -0,0 +1,26 @@ +{-| +Module : Data.OrgMode.Parse.Attoparsec.Drawer +Copyright : © 2017 Parnell Springmeyer +License : All Rights Reserved +Maintainer : Parnell Springmeyer +Stability : stable + +Attoparsec combinators for parsing drawers in org-mode documents. +-} + +module Data.OrgMode.Parse.Attoparsec.Drawer ( + +-- * Parse PROPERTY drawers + module Data.OrgMode.Parse.Attoparsec.Drawer.Property + +-- * Parse LOGBOOK drawers +, module Data.OrgMode.Parse.Attoparsec.Drawer.Logbook + +-- * Parse generic drawers +, module Data.OrgMode.Parse.Attoparsec.Drawer.Generic + +) where + +import Data.OrgMode.Parse.Attoparsec.Drawer.Generic +import Data.OrgMode.Parse.Attoparsec.Drawer.Logbook +import Data.OrgMode.Parse.Attoparsec.Drawer.Property diff --git a/src/Data/OrgMode/Parse/Attoparsec/Drawer/Generic.hs b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Generic.hs new file mode 100644 --- /dev/null +++ b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Generic.hs @@ -0,0 +1,68 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.OrgMode.Parse.Attoparsec.Drawer.Generic +-- Copyright : © 2017 Parnell Springmeyer +-- License : All Rights Reserved +-- Maintainer : Parnell Springmeyer +-- Stability : stable +-- +-- Parsing combinators for org-mode section generic drawers. +---------------------------------------------------------------------------- + +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.OrgMode.Parse.Attoparsec.Drawer.Generic +( parseDrawer +, parseDrawerDelim +, drawerEnd +) +where + +import Control.Applicative ((*>), (<*)) +import Data.Attoparsec.Text +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 + +-- | Parse a user-defined drawer. +-- +-- > :MYTEXT: +-- > whatever I want, can go in here except for headlines and drawers +-- > :END: +parseDrawer :: Attoparsec.Parser Text Drawer +parseDrawer = + Drawer <$> + parseDrawerName <*> + (Text.unlines <$> manyTill Util.nonHeadline drawerEnd) + +-- | Parse a user-defined drawer's name, e.g: +-- +-- > :DRAWERNAME: +-- > my text in a drawer +-- > :END: +parseDrawerName :: Attoparsec.Parser Text Text +parseDrawerName = + skipSpace *> skip (== ':') *> + takeWhile1 (/= ':') <* + skip (== ':') <* skipSpace + +-- | Parse drawer delimiters, e.g the beginning and end of a property +-- drawer: +-- +-- > :PROPERTIES: +-- > :END: +parseDrawerDelim :: Text -> Attoparsec.Parser Text Text +parseDrawerDelim v = + skipSpace *> skip (== ':') *> + asciiCI v <* + skip (== ':') <* skipSpace + +-- | Parse the @:END:@ of a drawer. +drawerEnd :: Attoparsec.Parser Text Text +drawerEnd = parseDrawerDelim "END" diff --git a/src/Data/OrgMode/Parse/Attoparsec/Drawer/Logbook.hs b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Logbook.hs new file mode 100644 --- /dev/null +++ b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Logbook.hs @@ -0,0 +1,38 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.OrgMode.Parse.Attoparsec.Drawer.Logbook +-- Copyright : © 2017 Parnell Springmeyer +-- License : All Rights Reserved +-- Maintainer : Parnell Springmeyer +-- Stability : stable +-- +-- Parsing combinators for org-mode section logbook drawers. +---------------------------------------------------------------------------- + +{-# LANGUAGE OverloadedStrings #-} + +module Data.OrgMode.Parse.Attoparsec.Drawer.Logbook +( parseLogbook +) +where + +import Control.Applicative ((*>)) +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) +import Data.OrgMode.Types + +-- | Parse a @LOGBOOK@ drawer. +-- +-- > :LOGBOOK: +-- > CLOCK: [2015-10-05 Mon 17:13]--[2015-10-05 Mon 17:14] => 0:01 +-- > :END: +parseLogbook :: Attoparsec.Parser Text Logbook +parseLogbook = Logbook <$> (drawerBegin *> manyTill parseClock Drawer.Generic.drawerEnd) + where + drawerBegin = Drawer.Generic.parseDrawerDelim "LOGBOOK" diff --git a/src/Data/OrgMode/Parse/Attoparsec/Drawer/Property.hs b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Property.hs new file mode 100644 --- /dev/null +++ b/src/Data/OrgMode/Parse/Attoparsec/Drawer/Property.hs @@ -0,0 +1,58 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.OrgMode.Parse.Attoparsec.Drawer.Property +-- Copyright : © 2014 Parnell Springmeyer +-- License : All Rights Reserved +-- Maintainer : Parnell Springmeyer +-- Stability : stable +-- +-- Parsing combinators for org-mode section property drawers. +---------------------------------------------------------------------------- + +{-# LANGUAGE OverloadedStrings #-} + +module Data.OrgMode.Parse.Attoparsec.Drawer.Property +( parseProperties +, property +, PropertyKey +, PropertyVal +) +where + +import Control.Applicative ((*>), (<*)) +import Data.Attoparsec.Text as T +import Data.Attoparsec.Types as Attoparsec +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 + +type PropertyKey = Text +type PropertyVal = Text + +-- | Parse a @PROPERTY@ drawer. +-- +-- > :PROPERTIES: +-- > :DATE: [2014-12-14 11:00] +-- > :NOTE: Something really crazy happened today! +-- > :END: +parseProperties :: Attoparsec.Parser Text Properties +parseProperties = Properties . fromList <$> (drawerBegin *> manyTill property Drawer.Generic.drawerEnd) + where + drawerBegin = Drawer.Generic.parseDrawerDelim "PROPERTIES" + +-- | 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 :: Attoparsec.Parser Text (PropertyKey, PropertyVal) +property = (,) <$> parseKey <*> parseVal + where + parseKey = skipSpace *> skip (== ':') *> takeWhile1 (/= ':') <* skip (== ':') + parseVal = Text.strip <$> (skipSpace *> takeValue) + takeValue = takeWhile1 (not . isEndOfLine) diff --git a/src/Data/OrgMode/Parse/Attoparsec/Headings.hs b/src/Data/OrgMode/Parse/Attoparsec/Headings.hs deleted file mode 100644 --- a/src/Data/OrgMode/Parse/Attoparsec/Headings.hs +++ /dev/null @@ -1,165 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.OrgMode.Parse.Attoparsec.Headings --- Copyright : © 2014 Parnell Springmeyer --- License : All Rights Reserved --- Maintainer : Parnell Springmeyer --- 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 ). --- --- 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.null t = fail "no data after ':'" - | (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' diff --git a/src/Data/OrgMode/Parse/Attoparsec/Headline.hs b/src/Data/OrgMode/Parse/Attoparsec/Headline.hs new file mode 100644 --- /dev/null +++ b/src/Data/OrgMode/Parse/Attoparsec/Headline.hs @@ -0,0 +1,193 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.OrgMode.Parse.Attoparsec.Headline +-- Copyright : © 2014 Parnell Springmeyer +-- License : All Rights Reserved +-- Maintainer : Parnell Springmeyer +-- Stability : stable +-- +-- Parsing combinators for org-mode headlines. +---------------------------------------------------------------------------- + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +module Data.OrgMode.Parse.Attoparsec.Headline +( headlineBelowDepth +, headlineDepth +, headingPriority +, parseStats +, parseTags +, mkTitleMeta +, TitleMeta +) +where + +import Control.Applicative +import Data.Attoparsec.Text +import Data.Attoparsec.Types as Attoparsec (Parser) +import Data.Maybe +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as Text +import Prelude hiding (takeWhile) +import Text.Printf + +import Data.OrgMode.Parse.Attoparsec.Section +import qualified Data.OrgMode.Parse.Attoparsec.Time as OrgMode.Time +import Data.OrgMode.Parse.Attoparsec.Util +import Data.OrgMode.Types + +-- | Intermediate type for parsing titles in a headline after the +-- state keyword and priority have been parsed. +newtype TitleMeta = TitleMeta (Text, Maybe Stats, Maybe [Tag]) + deriving (Eq, Show) + +-- | Parse an org-mode headline, its metadata, its section-body, and +-- any sub-headlines; please see +-- . +-- +-- Headline metadata includes a hierarchy level indicated by +-- asterisks, optional todo state keywords, an optional priority +-- level, %-done statistics, and tags; e.g: +-- +-- > ** TODO [#B] Polish Poetry Essay [25%] :HOMEWORK:POLISH:WRITING: +-- +-- Headlines may contain: +-- +-- - A section with Planning and Clock entries +-- - A number of other not-yet-implemented entities (code blocks, lists) +-- - Unstructured text +-- - Sub-headlines +-- +-- @headlineBelowDepth@ takes a list of terms to consider, state +-- keywords, and a minumum hierarchy depth. +-- +-- Use a @Depth@ of 0 to parse any headline. +headlineBelowDepth :: [Text] + -> Depth + -> Attoparsec.Parser Text Headline +headlineBelowDepth stateKeywords d = do + depth' <- headlineDepth d <* skipOnlySpace + stateKey <- option Nothing (Just <$> parseStateKeyword stateKeywords <* skipOnlySpace) + priority' <- option Nothing (Just <$> headingPriority <* skipOnlySpace) + tstamp <- option Nothing (Just <$> OrgMode.Time.parseTimestamp <* skipOnlySpace) + + -- Parse the title and any metadata within it + TitleMeta + ( titleText + , stats' + , (fromMaybe [] -> tags') + ) <- parseTitle + + section' <- parseSection + subHeadlines' <- option [] $ many' (headlineBelowDepth stateKeywords (d + 1)) + + skipSpace + pure $ Headline + { depth = depth' + , stateKeyword = stateKey + , priority = priority' + , title = titleText + , timestamp = tstamp + , stats = stats' + , tags = tags' + , section = section' + , subHeadlines = subHeadlines' + } + +-- | Parse the asterisk-indicated headline depth until a space is +-- encountered. +-- +-- Constrain it to @Depth@. +headlineDepth :: Depth -> Attoparsec.Parser Text Depth +headlineDepth (Depth d) = takeDepth >>= test + where + takeDepth = Text.length <$> takeWhile1 (== '*') + test n | n <= d = fail $ printf "Headline depth of %d cannot be higher than a depth constraint of %d" n d + | otherwise = pure $ Depth n + +-- | Parse the state indicator. +-- +-- > {`TODO` | `DONE` | custom } +-- +-- These can be custom so we're parsing additional state identifiers +-- as Text. +parseStateKeyword :: [Text] -> Attoparsec.Parser Text StateKeyword +parseStateKeyword (fmap 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 :: Attoparsec.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: +parseTitle :: Attoparsec.Parser Text TitleMeta +parseTitle = + mkTitleMeta <$> + titleStart <*> + (optMeta parseStats) <*> + (optMeta parseTags) <*> + -- Parse what's leftover AND till end of line or input; discarding + -- everything but the leftovers + leftovers <* (endOfLine <|> endOfInput) + where + titleStart = takeTill (\c -> inClass "[:" c || isEndOfLine c) + leftovers = option mempty $ takeTill (== '\n') + optMeta p = option Nothing (Just <$> p <* skipOnlySpace) + +-- | Produce a triple consisting of a stripped start-of-title if there +-- are no leftovers after parsing (otherwise, recombine the two) and +-- the optional stats and tags. +mkTitleMeta :: Text -- ^ Start of title till the end of line + -> Maybe Stats -- ^ Stats, e.g: [33%] + -> Maybe [Tag] -- ^ Tags, e.g: :HOMEWORK:CODE:SLEEP: + -> Text -- ^ Leftovers (may be empty) of the title + -> TitleMeta +mkTitleMeta start stats' tags' leftovers = + TitleMeta ((cleanTitle start leftovers), stats', tags') + where + cleanTitle t l + | Text.null leftovers = Text.strip t + | otherwise = Text.append t l + +-- | Parse a statisticss block, e.g: [33%]. +-- +-- Accepts either form: "[m/n]" or "[n%]" and there is no restriction +-- on m or n other than that they are integers. +parseStats :: Attoparsec.Parser Text Stats +parseStats = pct <|> frac + where + pct = StatsPct + <$> (char '[' *> decimal <* string "%]") + frac = StatsOf + <$> (char '[' *> decimal) + <*> (char '/' *> decimal <* char ']') + +-- | Parse a colon-separated list of tags. +-- +-- > :HOMEWORK:POETRY:WRITING: +parseTags :: Attoparsec.Parser Text [Tag] +parseTags = tags' >>= test + where + 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 + | Text.length t < 2 = fail $ Text.unpack $ "not a valid tag set: " <> t + | otherwise = pure (Text.splitOn ":" (Text.init t)) diff --git a/src/Data/OrgMode/Parse/Attoparsec/PropertyDrawer.hs b/src/Data/OrgMode/Parse/Attoparsec/PropertyDrawer.hs deleted file mode 100644 --- a/src/Data/OrgMode/Parse/Attoparsec/PropertyDrawer.hs +++ /dev/null @@ -1,59 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.OrgMode.Parse.Attoparsec.PropertyDrawer --- Copyright : © 2014 Parnell Springmeyer --- License : All Rights Reserved --- Maintainer : Parnell Springmeyer --- 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) 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 @@ -6,45 +6,39 @@ -- Maintainer : Parnell Springmeyer -- Stability : stable -- --- Parsing combinators for org-mode sections. +-- Parsing combinators for org-mode headline 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 Control.Applicative +import Data.Attoparsec.Text +import Data.Attoparsec.Types as Attoparsec +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as Text +import Prelude hiding (unlines) -import Data.OrgMode.Parse.Attoparsec.PropertyDrawer +import Data.OrgMode.Parse.Attoparsec.Drawer import Data.OrgMode.Parse.Attoparsec.Time -import Data.OrgMode.Parse.Types +import qualified Data.OrgMode.Parse.Attoparsec.Util as Util +import Data.OrgMode.Types + -- | Parse a heading section -- --- Heading sections contain optionally a property drawer, +-- Headline 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 - --- | Parse a non-heading line of a section. -nonHeaderLine :: TP.Parser Text Text -nonHeaderLine = nonHeaderLine0 <|> nonHeaderLine1 - where - nonHeaderLine0 = endOfLine >> return (pack "") - nonHeaderLine1 = pack <$> do - h <- notChar '*' - t <- manyTill anyChar endOfLine - return (h:t) +parseSection :: Attoparsec.Parser Text Section +parseSection = + Section + <$> option Nothing (Just <$> (skipSpace *> parseTimestamp <* skipSpace)) + <*> (Plns <$> parsePlannings) + <*> many' parseClock + <*> option mempty parseProperties + <*> option mempty parseLogbook + <*> many' parseDrawer + <*> (Text.unlines <$> many' Util.nonHeadline) 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 @@ -6,33 +6,42 @@ -- Maintainer : Parnell Springmeyer -- Stability : stable -- --- Parsing combinators for org-mode active and inactive timestamps. +-- Parsing combinators for org-mode timestamps; both active and +-- inactive. ---------------------------------------------------------------------------- +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} -module Data.OrgMode.Parse.Attoparsec.Time where +module Data.OrgMode.Parse.Attoparsec.Time +( parsePlannings +, parseClock +, parseTimestamp +) +where -import Control.Applicative (pure, some, - (*>), (<$>), (<*), (<*>), (<|>)) +import Control.Applicative 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 Data.Attoparsec.Combinator as TP +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.HashMap.Strict (HashMap, fromList) import Data.Maybe (listToMaybe) -import Data.Text as Text (Text, pack, unpack, - unwords) +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, takeWhile, - unwords, words) +import Prelude hiding (concat, null, repeat, + takeWhile, unwords, words) import System.Locale (defaultTimeLocale) -import Data.OrgMode.Parse.Types +import Data.OrgMode.Types -- | Parse a planning line. -- @@ -41,14 +50,14 @@ -- the same line e.g: -- -- > DEADLINE: <2015-05-10 17:00> CLOSED: <2015-04-1612:00> -parsePlannings :: TP.Parser Text (HashMap PlanningKeyword Timestamp) +parsePlannings :: Attoparsec.Parser Text (HashMap PlanningKeyword Timestamp) parsePlannings = fromList <$> (many' (skipSpace *> 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 - ] + where + planning = (,) <$> pType <* char ':' <*> (skipSpace *> parseTimestamp) + pType = choice [string "SCHEDULED" *> pure SCHEDULED + ,string "DEADLINE" *> pure DEADLINE + ,string "CLOSED" *> pure CLOSED + ] -- | Parse a clock line. -- @@ -56,8 +65,8 @@ -- 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 +parseClock :: Attoparsec.Parser Text Clock +parseClock = Clock <$> ((,) <$> (skipSpace *> string "CLOCK: " *> ts) <*> dur) where ts = option Nothing (Just <$> parseTimestamp) dur = option Nothing (Just <$> (string " => " @@ -75,47 +84,38 @@ -- -- Each timepoint includes an optional repeater flag and an optional -- delay flag. -parseTimestamp :: TP.Parser Text Timestamp +parseTimestamp :: Attoparsec.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 + -- TODO: refactor this case logic case (tsb1, blk2) of (Nothing, Nothing) -> - return (Timestamp ts1 act Nothing) + pure (Timestamp ts1 act Nothing) (Nothing, Just (ts2, Nothing, _)) -> - return (Timestamp ts1 act (Just ts2)) + 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) -> - return (Timestamp ts1 act + pure (Timestamp ts1 act (Just $ ts1 {hourMinute = Just (h',m') ,repeater = Nothing ,delay = Nothing})) - (Just _, Just _) -> fail "Illegal mix of time range and timestamp range" + (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 = 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] @@ -126,7 +126,7 @@ -- - 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 :: Attoparsec.Parser Text BracketedDateTime parseBracketedDateTime = do openingBracket <- char '<' <|> char '[' brkDateTime <- BracketedDateTime <$> @@ -142,104 +142,110 @@ where optionalParse p = option Nothing (Just <$> p) <* skipSpace maybeListParse p = listToMaybe <$> many' p <* skipSpace - activeBracket = (=='<') + activeBracket ((=='<') -> active) = + if active then Active else Inactive finally bkd ob cb | complementaryBracket ob /= cb = - fail "Mismatched timestamp brackets" + -- 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 --- 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) +-- | 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. -parseDay :: TP.Parser Text Text -parseDay = pack <$> some (TP.satisfyElem isDayChar) +-- +-- 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) - nonDayChars :: String - nonDayChars = "]+0123456789>\r\n -" - -- The above syntax is based on [^]+0-9>\r\n -]+ - -- a part of regexp named org-ts-regexp0 - -- in org.el . - - -type AbsoluteTime = (Hours, Minutes) -type TimestampRange = (AbsoluteTime, AbsoluteTime) - -newtype TimePart = TimePart (Either AbsoluteTime TimestampRange) - deriving (Eq, Ord, Show) + -- | 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' :: TP.Parser Text TimePart -parseTime' = - TimePart <$> choice [ Right <$> ((,) <$> parseHM <* char '-' <*> parseHM) - , Left <$> parseHM - ] +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 :: TP.Parser Text YearMonthDay -parseDate = consumeDate >>= either failure success . dateParse +parseDate :: Attoparsec.Parser Text YearMonthDay +parseDate = consumeDate >>= either bad good . 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 + 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 :: TP.Parser Text (Hours, Minutes) +parseHM :: Attoparsec.Parser Text (Hours, Minutes) parseHM = (,) <$> decimal <* char ':' <*> decimal -- | Parse the Timeunit part of a delay or repeater flag. -parseTimeUnit :: TP.Parser Text TimeUnit +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' *> 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 :: Attoparsec.Parser Text Repeater parseRepeater = - Repeater - <$> choice[ string "++" *> pure RepeatCumulate - , char '+' *> pure RepeatCatchUp - , string ".+" *> pure RepeatRestart - ] - <*> decimal - <*> parseTimeUnit + 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 :: Attoparsec.Parser Text Delay parseDelay = - Delay - <$> choice [ string "--" *> pure DelayFirst - , char '-' *> pure DelayAll - ] - <*> decimal - <*> parseTimeUnit + Delay + <$> choice + [ string "--" *> pure DelayFirst + , char '-' *> pure DelayAll + ] + <*> decimal + <*> parseTimeUnit diff --git a/src/Data/OrgMode/Parse/Attoparsec/Util.hs b/src/Data/OrgMode/Parse/Attoparsec/Util.hs new file mode 100644 --- /dev/null +++ b/src/Data/OrgMode/Parse/Attoparsec/Util.hs @@ -0,0 +1,43 @@ +{-| +Module : Data.OrgMode.Parse.Attoparsec.Util +Copyright : © 2017 Parnell Springmeyer +License : All Rights Reserved +Maintainer : Parnell Springmeyer +Stability : stable + +Attoparsec utilities. +-} + +module Data.OrgMode.Parse.Attoparsec.Util +( skipOnlySpace +, nonHeadline +) +where + +import Control.Applicative ((<|>)) +import qualified Data.Attoparsec.Text as Attoparsec.Text +import Data.Attoparsec.Types (Parser) +import Data.Text (Text) +import qualified Data.Text as Text + + +-- | Skip whitespace characters, only! +-- +-- @Data.Attoparsec.Text.skipSpace@ uses the @isSpace@ predicate from +-- @Data.Char@ which also includes control characters such as a return +-- and newline which we need to *not* consume in some cases during +-- parsing. +skipOnlySpace :: Parser Text () +skipOnlySpace = Attoparsec.Text.skipWhile spacePred + where + spacePred s = s == ' ' || s == '\t' + +-- | Parse a non-heading line of a section. +nonHeadline :: Parser Text Text +nonHeadline = nonHeadline0 <|> nonHeadline1 + where + nonHeadline0 = Attoparsec.Text.endOfLine *> pure (Text.pack "") + nonHeadline1 = Text.pack <$> do + h <- Attoparsec.Text.notChar '*' + t <- Attoparsec.Text.manyTill Attoparsec.Text.anyChar Attoparsec.Text.endOfLine + pure (h:t) diff --git a/src/Data/OrgMode/Parse/Types.hs b/src/Data/OrgMode/Parse/Types.hs deleted file mode 100644 --- a/src/Data/OrgMode/Parse/Types.hs +++ /dev/null @@ -1,235 +0,0 @@ -{-| -Module : Data.OrgMode.Parse.Types -Copyright : © 2014 Parnell Springmeyer -License : All Rights Reserved -Maintainer : Parnell Springmeyer -Stability : experimental - -Types and utility functions. --} - -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} - -module Data.OrgMode.Parse.Types -( Document (..) -, Section (..) -, Level (..) -, Heading (..) -, Priority (..) -, Plannings (..) -, StateKeyword (..) -, Duration -, PlanningKeyword (..) -, Properties -, Timestamp (..) -, DateTime (..) -, Stats (..) -, Tag -, TimeUnit (..) -, RepeaterType (..) -, Repeater (..) -, DelayType (..) -, Delay (..) -, LevelDepth (..) -, TitleMeta (..) -, YearMonthDay(..) -, YearMonthDay'(..) -) where - -import Control.Applicative -import Control.Monad (mzero) -import Data.Aeson ((.:), (.=)) -import qualified Data.Aeson as A -import Data.Hashable (Hashable (..)) -import Data.HashMap.Strict (HashMap, fromList, keys, toList) -import Data.Text (Text, pack) -import Data.Thyme.Calendar (YearMonthDay (..)) -import Data.Thyme.LocalTime (Hour, Minute) -import Data.Traversable -import GHC.Generics - -data Document = Document { - documentText :: Text -- ^ Text occurring before any Org headlines - , documentHeadings :: [Heading] -- ^ Toplevel Org headlines - } deriving (Show, Eq, Generic) - -instance A.ToJSON Document where -instance A.FromJSON Document where - -newtype LevelDepth = LevelDepth Int - deriving (Eq, Show, Num) - -data TitleMeta = TitleMeta Text (Maybe Stats) (Maybe [Tag]) - deriving (Eq, Show) - -data Heading = Heading - { level :: Level -- ^ Org headline nesting level (1 is at the top) - , keyword :: Maybe StateKeyword -- ^ State of the headline (e.g. TODO, DONE) - , priority :: Maybe Priority -- - , title :: Text -- properties - , stats :: Maybe Stats -- - , tags :: [Tag] -- - , section :: Section -- Next-line - , subHeadings :: [Heading] -- elements - } deriving (Show, Eq, Generic) - -newtype Level = Level Int deriving (Eq, Show, Num, Generic) - -type Properties = HashMap Text Text -type Clock = (Maybe Timestamp, Maybe Duration) - -data Section = Section { - sectionPlannings :: Plannings - , sectionClocks :: [Clock] - , sectionProperties :: Properties - , sectionParagraph :: Text - } deriving (Show, Eq, Generic) - - -data Timestamp = Timestamp { - tsTime :: DateTime - , tsActive :: Bool - , tsEndTime :: Maybe DateTime - } deriving (Show, Eq, Generic) - -instance A.ToJSON Timestamp where -instance A.FromJSON Timestamp where - - -newtype YearMonthDay' = YMD' YearMonthDay - deriving (Show, Eq, Generic) - -instance A.ToJSON YearMonthDay' where - toJSON (YMD' (YearMonthDay y m d)) = - A.object ["ymdYear" .= y - ,"ymdMonth" .= m - ,"ymdDay" .= d] - -instance A.FromJSON YearMonthDay' where - parseJSON (A.Object v) = do - y <- v .: "ymdYear" - m <- v .: "ymdMonth" - d <- v .: "ymdDay" - return (YMD' (YearMonthDay y m d)) - parseJSON _ = mzero - -data DateTime = DateTime { - yearMonthDay :: YearMonthDay' - , dayName :: Maybe Text - , hourMinute :: Maybe (Hour,Minute) - , repeater :: Maybe Repeater - , delay :: Maybe Delay - } deriving (Show, Eq, Generic) - -instance A.ToJSON DateTime where -instance A.FromJSON DateTime where - -data RepeaterType = RepeatCumulate | RepeatCatchUp | RepeatRestart - deriving (Show, Eq, Generic) - -instance A.ToJSON RepeaterType -instance A.FromJSON RepeaterType - -data Repeater = Repeater { - repeaterType :: RepeaterType - , repeaterValue :: Int - , repeaterUnit :: TimeUnit - } deriving (Show, Eq, Generic) - -instance A.ToJSON Repeater where -instance A.FromJSON Repeater where - -data DelayType = DelayAll | DelayFirst - deriving (Show, Eq, Generic) - -instance A.ToJSON DelayType where -instance A.FromJSON DelayType where - -data Delay = Delay { - delayType :: DelayType - , delayValue :: Int - , delayUnit :: TimeUnit - } deriving (Show, Eq, Generic) - -instance A.ToJSON Delay where -instance A.FromJSON Delay where - -data TimeUnit = UnitYear - | UnitWeek - | UnitMonth - | UnitDay - | UnitHour - deriving (Show, Eq, Generic) - -instance A.ToJSON TimeUnit where -instance A.FromJSON TimeUnit where - ---------------------------------------------------------------------------- ---instance A.ToJSON Document where ---instance A.FromJSON Document where - -instance A.ToJSON Level where -instance A.FromJSON Level where - -newtype StateKeyword = StateKeyword {unStateKeyword :: Text} - deriving (Show, Eq, Generic) - -instance A.ToJSON StateKeyword where -instance A.FromJSON StateKeyword where - - -data PlanningKeyword = SCHEDULED | DEADLINE | CLOSED - deriving (Show, Eq, Enum, Ord, Generic) - -instance A.ToJSON PlanningKeyword where -instance A.FromJSON PlanningKeyword where - ---instance (A.ToJSON k, A.ToJSON v) => A.ToJSON (HashMap k v) where --- toJSON hm = A.object hm - -newtype Plannings = Plns (HashMap PlanningKeyword Timestamp) - deriving (Show, Eq, Generic) - -instance A.ToJSON Plannings where - toJSON (Plns hm) = A.object $ map jPair (toList hm) - where jPair (k, v) = pack (show k) .= A.toJSON v - -instance A.FromJSON Plannings where - parseJSON (A.Object v) = Plns . fromList <$> (traverse jPair (keys v)) - where jPair k = v .: k - parseJSON _ = mzero - -instance A.ToJSON Section where -instance A.FromJSON Section where - -instance A.ToJSON Heading where -instance A.FromJSON Heading where - -data Priority = A | B | C - deriving (Show, Read, Eq, Ord, Generic) - -instance A.ToJSON Priority where -instance A.FromJSON Priority where -type Tag = Text - -data Stats = StatsPct Int - | StatsOf Int Int - deriving (Show, Eq, Generic) - -instance A.ToJSON Stats where -instance A.FromJSON Stats where - -type Duration = (Hour,Minute) - -instance Hashable PlanningKeyword where - hashWithSalt salt k = hashWithSalt salt (fromEnum k) - --- -- This might be the form to use if we were supporting timestamps --- data Timestamp = Dairy Text --- | Time TimestampTime --- deriving (Show, Eq, Generic) - - - diff --git a/src/Data/OrgMode/Types.hs b/src/Data/OrgMode/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/OrgMode/Types.hs @@ -0,0 +1,310 @@ +{-| +Module : Data.OrgMode.Types +Copyright : © 2014 Parnell Springmeyer +License : All Rights Reserved +Maintainer : Parnell Springmeyer +Stability : experimental + +Types for the AST of an org-mode document. +-} + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS -fno-warn-orphans #-} + +module Data.OrgMode.Types +( ActiveState (..) +, BracketedDateTime (..) +, Clock (..) +, DateTime (..) +, Delay (..) +, DelayType (..) +, Depth (..) +, Document (..) +, Drawer (..) +, Duration +, Headline (..) +, Logbook (..) +, PlanningKeyword (..) +, Plannings (..) +, Priority (..) +, Properties (..) +, Repeater (..) +, RepeaterType (..) +, Section (..) +, StateKeyword (..) +, Stats (..) +, Tag +, TimePart (..) +, TimeUnit (..) +, Timestamp (..) +, YearMonthDay (..) +) where + +import Control.Monad (mzero) +import Data.Aeson ((.:), (.=)) +import qualified Data.Aeson as Aeson +import Data.Hashable (Hashable (..)) +import Data.HashMap.Strict (HashMap, fromList, keys, toList) +import Data.Text (Text, pack) +import Data.Thyme.Calendar (YearMonthDay (..)) +import Data.Thyme.LocalTime (Hour, Hours, Minute, Minutes) +import GHC.Generics + +-- | Org-mode document. +data Document = Document + { documentText :: Text -- ^ Text occurring before any Org headlines + , documentHeadlines :: [Headline] -- ^ Toplevel Org headlines + } deriving (Show, Eq, Generic) + +instance Aeson.ToJSON Document +instance Aeson.FromJSON Document + +-- | Headline within an org-mode document. +data Headline = Headline + { depth :: Depth -- ^ Org headline nesting depth (1 is at the top), e.g: * or ** or *** + , stateKeyword :: Maybe StateKeyword -- ^ State of the headline, e.g: TODO, DONE + , priority :: Maybe Priority -- ^ Headline priority, e.g: [#A] + , title :: Text -- ^ Primary text of the headline + , timestamp :: Maybe Timestamp -- ^ A timestamp that may be embedded in the headline + , stats :: Maybe Stats -- ^ Fraction of subtasks completed, e.g: [33%] or [1/2] + , tags :: [Tag] -- ^ Tags on the headline + , section :: Section -- ^ The body underneath a headline + , subHeadlines :: [Headline] -- ^ A list of sub-headlines + } deriving (Show, Eq, Generic) + +-- | Headline nesting depth. +newtype Depth = Depth Int + deriving (Eq, Show, Num, Generic) + +instance Aeson.ToJSON Depth +instance Aeson.FromJSON Depth + +-- | Section of text directly following a headline. +data Section = Section + { sectionTimestamp :: Maybe Timestamp -- ^ A headline's section timestamp + , sectionPlannings :: Plannings -- ^ A map of planning timestamps + , sectionClocks :: [Clock] -- ^ A list of clocks + , sectionProperties :: Properties -- ^ A map of properties from the :PROPERTY: drawer + , sectionLogbook :: Logbook -- ^ A list of clocks from the :LOGBOOK: drawer + , sectionDrawers :: [Drawer] -- ^ A list of parsed user-defined drawers + , sectionParagraph :: Text -- ^ Arbitrary text + } deriving (Show, Eq, Generic) + +newtype Properties = Properties { unProperties :: HashMap Text Text } + deriving (Show, Eq, Generic, Monoid) + +instance Aeson.ToJSON Properties +instance Aeson.FromJSON Properties + +newtype Logbook = Logbook { unLogbook :: [Clock] } + deriving (Show, Eq, Generic, Monoid) + +instance Aeson.ToJSON Logbook +instance Aeson.FromJSON Logbook + +data Drawer = Drawer + { name :: Text + , contents :: Text + } deriving (Show, Eq, Generic) + +instance Aeson.ToJSON Drawer +instance Aeson.FromJSON Drawer + +-- | Sum type indicating the active state of a timestamp. +data ActiveState + = Active + | Inactive + deriving (Show, Eq, Read, Generic) + +instance Aeson.ToJSON ActiveState +instance Aeson.FromJSON ActiveState + +newtype Clock = Clock { unClock :: (Maybe Timestamp, Maybe Duration) } + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON Clock +instance Aeson.FromJSON Clock + +-- | A generic data type for parsed org-mode time stamps, e.g: +-- +-- > <2015-03-27 Fri 10:20> +-- > [2015-03-27 Fri 10:20 +4h] +-- > <2015-03-27 Fri 10:20>--<2015-03-28 Sat 10:20> +data Timestamp = Timestamp + { tsTime :: DateTime -- ^ A datetime stamp + , tsActive :: ActiveState -- ^ Active or inactive? + , tsEndTime :: Maybe DateTime -- ^ A end-of-range datetime stamp + } deriving (Show, Eq, Generic) + +instance Aeson.ToJSON Timestamp +instance Aeson.FromJSON Timestamp + +instance Aeson.ToJSON YearMonthDay where + toJSON (YearMonthDay y m d) = + Aeson.object + [ "ymdYear" .= y + , "ymdMonth" .= m + , "ymdDay" .= d + ] + +instance Aeson.FromJSON YearMonthDay where + parseJSON (Aeson.Object v) = do + y <- v .: "ymdYear" + m <- v .: "ymdMonth" + d <- v .: "ymdDay" + pure (YearMonthDay y m d) + parseJSON _ = mzero + + +type Weekday = Text +type AbsTime = (Hours, Minutes) + +-- | A data type for parsed org-mode bracketed datetime stamps, e.g: +-- +-- > [2015-03-27 Fri 10:20 +4h] +data BracketedDateTime = BracketedDateTime + { datePart :: YearMonthDay + , dayNamePart :: Maybe Weekday + , timePart :: Maybe TimePart + , repeat :: Maybe Repeater + , delayPart :: Maybe Delay + , activeState :: ActiveState + } deriving (Show, Eq) + +-- | A sum type representing an absolute time part of a bracketed +-- org-mode datetime stamp or a time range between two absolute +-- timestamps. +data TimePart + = AbsoluteTime AbsTime + | TimeStampRange (AbsTime, AbsTime) + deriving (Eq, Ord, Show) + +-- | A data type for parsed org-mode datetime stamps. +-- +-- TODO: why do we have this data type and BracketedDateTime? They +-- look almost exactly the same... +data DateTime = DateTime { + yearMonthDay :: YearMonthDay + , dayName :: Maybe Text + , hourMinute :: Maybe (Hour,Minute) + , repeater :: Maybe Repeater + , delay :: Maybe Delay + } deriving (Show, Eq, Generic) + +instance Aeson.ToJSON DateTime +instance Aeson.FromJSON DateTime + +-- | A sum type representing the repeater type of a repeater interval +-- in a org-mode timestamp. +data RepeaterType + = RepeatCumulate + | RepeatCatchUp + | RepeatRestart + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON RepeaterType +instance Aeson.FromJSON RepeaterType + +-- | A data type representing a repeater interval in a org-mode +-- timestamp. +data Repeater = Repeater + { repeaterType :: RepeaterType -- ^ Type of repeater + , repeaterValue :: Int -- ^ Repeat value + , repeaterUnit :: TimeUnit -- ^ Repeat time unit + } deriving (Show, Eq, Generic) + +instance Aeson.ToJSON Repeater +instance Aeson.FromJSON Repeater + +-- | A sum type representing the delay type of a delay value. +data DelayType + = DelayAll + | DelayFirst + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON DelayType +instance Aeson.FromJSON DelayType + +-- | A data type representing a delay value. +data Delay = Delay + { delayType :: DelayType -- ^ Type of delay + , delayValue :: Int -- ^ Delay value + , delayUnit :: TimeUnit -- ^ Delay time unit + } deriving (Show, Eq, Generic) + +instance Aeson.ToJSON Delay +instance Aeson.FromJSON Delay + +-- | A sum type representing the time units of a delay. +data TimeUnit + = UnitYear + | UnitWeek + | UnitMonth + | UnitDay + | UnitHour + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON TimeUnit +instance Aeson.FromJSON TimeUnit + +-- | A type representing a headline state keyword, e.g: @TODO@, +-- @DONE@, @WAITING@, etc. +newtype StateKeyword = StateKeyword {unStateKeyword :: Text} + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON StateKeyword +instance Aeson.FromJSON StateKeyword + +-- | A sum type representing the planning keywords. +data PlanningKeyword = SCHEDULED | DEADLINE | CLOSED + deriving (Show, Eq, Enum, Ord, Generic) + +instance Aeson.ToJSON PlanningKeyword +instance Aeson.FromJSON PlanningKeyword + +-- | A type representing a map of planning timestamps. +newtype Plannings = Plns (HashMap PlanningKeyword Timestamp) + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON Plannings where + toJSON (Plns hm) = Aeson.object $ map jPair (toList hm) + 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)) + where jPair k = v .: k + parseJSON _ = mzero + +instance Aeson.ToJSON Section +instance Aeson.FromJSON Section + +instance Aeson.ToJSON Headline +instance Aeson.FromJSON Headline + +-- | A sum type representing the three default priorities: @A@, @B@, +-- and @C@. +data Priority = A | B | C + deriving (Show, Read, Eq, Ord, Generic) + +instance Aeson.ToJSON Priority +instance Aeson.FromJSON Priority +type Tag = Text + +-- | A data type representing a stats value in a headline, e.g @[2/3]@ +-- in this headline: +-- +-- > * TODO [2/3] work on orgmode-parse +data Stats = StatsPct Int + | StatsOf Int Int + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON Stats +instance Aeson.FromJSON Stats + +type Duration = (Hour,Minute) + +instance Hashable PlanningKeyword where + hashWithSalt salt k = hashWithSalt salt (fromEnum k) diff --git a/test/Document.hs b/test/Document.hs new file mode 100644 --- /dev/null +++ b/test/Document.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Document where + +import Data.Attoparsec.Text +import Data.Text +import qualified Data.Text as Text +import qualified Data.Text.IO as TextIO +import Test.Tasty +import Test.Tasty.HUnit + +import Data.OrgMode.Parse.Attoparsec.Document +import Data.OrgMode.Parse.Attoparsec.Time +import Data.OrgMode.Types +import Util + +parserSmallDocumentTests :: TestTree +parserSmallDocumentTests = testGroup "Attoparsec Small Document" + [ testCase "Parse Empty Document" $ + testDocS "" (Document "" []) + + , testCase "Parse No Headline" $ + testDocS pText (Document pText []) + + , testCase "Parse Headline Sample A" $ + testDocS sampleAText sampleAParse + + , testCase "Parse Headline with Planning" $ + testDocS samplePText samplePParse + + , testCase "Parse Headline no \n" $ + testDocS "* T" (Document "" [emptyHeadline {title="T"}]) + + , testCase "Parse Document from File" $ + testDocFile + ] + + where + testDocS s r = expectParse (parseDocument kw) s (Right r) + testDocFile = do + doc <- TextIO.readFile "test/test-document.org" + assertBool "Expected to parse document" . parseSucceeded $ parseOnly (parseDocument kw) doc + kw = ["TODO", "CANCELED", "DONE"] + pText = "Paragraph text\n.No headline here.\n##--------\n" + parseSucceeded (Right _) = True + parseSucceeded (Left _ ) = False + +sampleAText :: Text +sampleAText = Text.concat [sampleParagraph,"* Test1", spaces 20,":Hi there:\n" + ,"*\n" + ," *\n" + ,"* Test2 :Two:Tags:\n" + ] +sampleAParse :: Document +sampleAParse = Document + sampleParagraph + [emptyHeadline {title="Test1", tags=["Hi there"]} + ,emptyHeadline {section=emptySection{sectionParagraph=" *\n"}} + ,emptyHeadline {title="Test2", tags=["Two","Tags"]} + ] + +samplePText :: Text +samplePText = Text.concat ["* Test3\n" + ," SCHEDULED: <2015-06-12 Fri>" + ] + +samplePParse :: Document +samplePParse = Document + "" + [emptyHeadline {title="Test3",section=emptySection{sectionPlannings=plns}} + ] + where + plns :: Plannings + plns = Plns con + + Right con = parseOnly parsePlannings "SCHEDULED: <2015-06-12 Fri>" + +emptyHeadline :: Headline +emptyHeadline = + Headline + { depth = 1 + , stateKeyword = Nothing + , priority = Nothing + , title = "" + , stats = Nothing + , timestamp = Nothing + , tags = [] + , section = emptySection + , subHeadlines = [] + } + +sampleParagraph :: Text +sampleParagraph = "This is some sample text in a paragraph which may contain * , : , and other special characters.\n\n" + +spaces :: Int -> Text +spaces = flip Text.replicate " " + +emptySection :: Section +emptySection = Section Nothing (Plns mempty) mempty mempty mempty mempty mempty diff --git a/test/Drawer.hs b/test/Drawer.hs new file mode 100644 --- /dev/null +++ b/test/Drawer.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Drawer where + +import Data.OrgMode.Parse +import Test.Tasty +import Test.Tasty.HUnit + +import Util + +parserDrawerTests :: TestTree +parserDrawerTests = testGroup "Attoparsec PropertyDrawer" + [ testCase "Parse a :PROPERTY: drawer" $ + testPropertyDrawer + + , testCase "Parse empty :PROPERTY: drawer" $ + (testParser parseProperties ":PROPERTIES:\n:END:\n") + + , testCase "Parse a :LOGBOOK: drawer" $ + testLogbookDrawer + + , testCase "Parse a user-defined drawer" $ + testGenericDrawer + ] + +testPropertyDrawer :: Assertion +testPropertyDrawer = + testParser parseProperties ":PROPERTIES:\n :URL: http://someurl.com?query\n :notes: you should be taking them\n:END:\n" + +testLogbookDrawer :: Assertion +testLogbookDrawer = + testParser parseLogbook ":LOGBOOK:\n CLOCK: [2015-10-05 Mon 17:13] \n CLOCK: [2015-10-05 Mon 17:13]--[2015-10-05 Mon 17:14] => 0:01\n:END:\n" + +testGenericDrawer :: Assertion +testGenericDrawer = + testParser parseDrawer ":MYDRAWER:\n whatever I want can go in here, technically... \n:END:\n" diff --git a/test/Headline.hs b/test/Headline.hs new file mode 100644 --- /dev/null +++ b/test/Headline.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Headline where + +import Data.OrgMode.Parse +import Test.Tasty +import Test.Tasty.HUnit + +import Util + +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] Pickup groceris on <2017-08-24 22:00>\n") + ] + where + testHeadline = testParser (headlineBelowDepth ["TODO","CANCELED","DONE"] 0) diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -3,11 +3,11 @@ module Main where -import Headings -import PropertyDrawer +import Document +import Drawer +import Headline import Test.Tasty import Timestamps -import Document main :: IO () main = defaultMain tests @@ -15,8 +15,8 @@ tests :: TestTree tests = testGroup "OrgMode Parser Tests" - [ parserHeadingTests - , parserPropertyDrawerTests + [ parserHeadlineTests + , parserDrawerTests , parserTimestampTests , parserSmallDocumentTests , parserWeekdayTests diff --git a/test/Timestamps.hs b/test/Timestamps.hs new file mode 100644 --- /dev/null +++ b/test/Timestamps.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Timestamps where + +import Control.Applicative ((<*)) +import Data.Attoparsec.Text (endOfLine) +import Data.HashMap.Strict +import Data.Monoid ((<>)) +import Data.OrgMode.Parse +import qualified Data.Text as T +import Test.Tasty +import Test.Tasty.HUnit +import Weekdays (weekdays) + +import Data.OrgMode.Types +import Util + +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) + ] + where + testPlanning t = testParser parsePlannings t + testPlanningS t r = expectParse parsePlannings t (Right r) + + (sExampleStrA, sExampleResA) = + ("SCHEDULED: <2004-02-29 Sun 10:20 +1w -2d>" + ,(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)])) + +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") + ] + where + testTimestamp t = testParser (parseTimestamp <* endOfLine) t + + +parserWeekdayTests :: TestTree +parserWeekdayTests = testGroup "Attoparsec Weekday" + [testCase ("Parse Weekday in " ++ loc) $ mkTest w + | (loc,ws) <- weekdays, w <- ws, isOrgParsable w] + where + dayChars = "]+0123456789>\r\n -" :: String + isOrgParsable w = T.find (\c -> c `elem` dayChars) w == Nothing + mkTest w = expectParse parseTimestamp str (Right res) + where + str = "<2004-02-29 " <> w <> " 10:20>" + res = Timestamp (DateTime + (YearMonthDay 2004 2 29) + (Just w) + (Just (10,20)) + Nothing + Nothing) Active Nothing diff --git a/test/Util.hs b/test/Util.hs new file mode 100644 --- /dev/null +++ b/test/Util.hs @@ -0,0 +1,25 @@ +module Util where + +import Data.Attoparsec.Text +import Data.Attoparsec.Types as TP +import Data.Either +import Data.Text as T +import Test.HUnit + +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 + -> Text -- ^ Message under test + -> Either String a -- ^ Expected parse result + -> Assertion +expectParse p t (Left _) = assertBool "Expected parse failure" + (isLeft (parseOnly p t)) +expectParse p t a = assertBool msg (r == a) + where r = parseOnly p t + msg = Prelude.unwords + ["Expected parse to", show a, ". Got", show r] + +fromEither :: Either String a -> Assertion +fromEither (Left e) = assertBool e False +fromEither (Right _) = assertBool "" True diff --git a/test/Weekdays.hs b/test/Weekdays.hs new file mode 100644 --- /dev/null +++ b/test/Weekdays.hs @@ -0,0 +1,267 @@ +{-# LANGUAGE OverloadedStrings #-} +module Weekdays where + +import qualified Data.Text as T + +weekdays :: [(String, [T.Text])] +weekdays = [ + ("aa_DJ.UTF-8", ["kam", "gum", "sab", "aca", "etl", "tal", "arb"]), + ("aa_ER", ["Kam", "Gum", "Sab", "Aca", "Etl", "Tal", "Arb"]), + ("aa_ER@saaho", ["Cam", "Jum", "Qun", "Nab", "San", "Sal", "Rab"]), + ("aa_ET", ["Kam", "Gum", "Sab", "Aca", "Etl", "Tal", "Arb"]), + ("af_ZA.UTF-8", ["Do", "Vr", "Sa", "So", "Ma", "Di", "Wo"]), + ("am_ET", ["ሐሙስ", "ዓርብ", "ቅዳሜ", "እሑድ", "ሰኞ ", "ማክሰ", "ረቡዕ"]), + ("an_ES.UTF-8", ["chu", "bie", "sab", "dom", "lun", "mar", "mie"]), + ("ar_AE.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_BH.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_DZ.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_EG.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_IN", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_IQ.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_JO.UTF-8", ["الخميس", "الجمعة", "السبت", "الأحد", "الاثنين", "الثلاثاء", "الأربعاء"]), + ("ar_KW.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_LB.UTF-8", ["الخميس", "الجمعة", "السبت", "الأحد", "الاثنين", "الثلاثاء", "الأربعاء"]), + ("ar_LY.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_MA.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_OM.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_QA.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_SA.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("ar_SD.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_SY.UTF-8", ["الخميس", "الجمعة", "السبت", "الأحد", "الاثنين", "الثلاثاء", "الأربعاء"]), + ("ar_TN.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("ar_YE.UTF-8", ["خ", "ج", "س", "ح", "ن", "ث", "ر"]), + ("az_AZ.UTF-8", ["cax", "cüm", "şnb", "baz", "ber", "çax", "çər"]), + ("as_IN.UTF-8", ["বৃহষ্পতি", "শুক্ৰ", "শনি", "দেও", "সোম", "মঙ্গল", "বুধ"]), + ("ast_ES.UTF-8", ["xue", "vie", "sáb", "dom", "llu", "mar", "mié"]), + ("be_BY.UTF-8", ["Чцв", "Пят", "Суб", "Няд", "Пан", "Аўт", "Срд"]), + ("be_BY@latin", ["Čać", "Pia", "Sub", "Nia", "Pan", "Aŭt", "Sie"]), + ("bem_ZM", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("ber_DZ", ["dör", "beş", "alt", "baz", "bir", "iki", "üçü"]), + ("ber_MA", ["dör", "beş", "alt", "baz", "bir", "iki", "üçü"]), + ("bg_BG.UTF-8", ["чт", "пт", "сб", "нд", "пн", "вт", "ср"]), + ("bn_BD", ["বৃহঃ", "শুক্র", "শনি", "রবি", "সোম", "মঙ্গল", "বুধ"]), + ("bn_IN", ["বৃহস্পতি", "শুক্র", "শনি", "রবি", "সোম", "মঙ্গল", "বুধ"]), + ("bo_CN", ["པུར་", "སངས་", "སྤེན་", "ཉི་", "ཟླ་", "མིར་", "ལྷག་"]), + ("bo_IN", ["པུར་", "སངས་", "སྤེན་", "ཉི་", "ཟླ་", "མིར་", "ལྷག་"]), + ("br_FR.UTF-8", ["yao", "gwe", "sad", "sul", "lun", "meu", "mer"]), + ("bs_BA.UTF-8", ["Čet", "Pet", "Sub", "Ned", "Pon", "Uto", "Sri"]), + ("byn_ER", ["ኣምድ", "ኣርብ", "ሰ/ሽ", "ሰ/ቅ", "ሰኑ", "ሰሊጝ", "ለጓ"]), + ("ca_AD.UTF-8", ["dj", "dv", "ds", "dg", "dl", "dt", "dc"]), + ("ca_ES.UTF-8", ["dj", "dv", "ds", "dg", "dl", "dt", "dc"]), + ("ca_ES.UTF-8@valencia", ["dj", "dv", "ds", "dg", "dl", "dt", "dc"]), + ("ca_FR.UTF-8", ["dj", "dv", "ds", "dg", "dl", "dt", "dc"]), + ("ca_IT.UTF-8", ["dj", "dv", "ds", "dg", "dl", "dt", "dc"]), + ("crh_UA", ["Caq", "Cum", "Cer", "Baz", "Ber", "Sal", "Çar"]), + ("cs_CZ.UTF-8", ["Čt", "Pá", "So", "Ne", "Po", "Út", "St"]), + ("csb_PL", ["czw", "pią", "sob", "nie", "pòn", "wtó", "str"]), + ("cv_RU", ["kş", "er", "šm", "vr", "tn", "yt", "jn"]), + ("cy_GB.UTF-8", ["Iau", "Gwe", "Sad", "Sul", "Llu", "Maw", "Mer"]), + ("da_DK.UTF-8", ["tor", "fre", "lør", "søn", "man", "tir", "ons"]), + ("de_AT.UTF-8", ["Don", "Fre", "Sam", "Son", "Mon", "Die", "Mit"]), + ("de_BE.UTF-8", ["Don", "Fre", "Sam", "Son", "Mon", "Die", "Mit"]), + ("de_CH.UTF-8", ["Don", "Fre", "Sam", "Son", "Mon", "Die", "Mit"]), + ("de_DE.UTF-8", ["Do", "Fr", "Sa", "So", "Mo", "Di", "Mi"]), + ("de_LI.UTF-8", ["Don", "Fre", "Sam", "Son", "Mon", "Die", "Mit"]), + ("de_LU.UTF-8", ["Don", "Fre", "Sam", "Son", "Mon", "Die", "Mit"]), + ("dv_MV", ["ބުރާސްފަތި", "ހުކުރު", "ހޮނިހިރު", "އާދީއްތަ", "ހޯމަ", "އަންގާރަ", "ބުދަ"]), + ("dz_BT", ["སངས་", "སྤེན་", "ཉི་", "ཟླ་", "མིར་", "ལྷག་", "པུར་"]), + ("el_GR.UTF-8", ["Πεμ", "Παρ", "Σαβ", "Κυρ", "Δευ", "Τρι", "Τετ"]), + ("el_CY.UTF-8", ["Πεμ", "Παρ", "Σαβ", "Κυρ", "Δευ", "Τρι", "Τετ"]), + ("en_AG", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_AU.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_BW.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_CA.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_DK.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_GB.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_HK.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_IE.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_IN", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_NG", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_NZ.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_PH.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_SG.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_US.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_ZA.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_ZM", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("en_ZW.UTF-8", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("eo.UTF-8", ["ĵaŭ", "ven", "sab", "dim", "lun", "mar", "mer"]), + ("es_AR.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_BO.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_CL.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_CO.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_CR.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_DO.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_EC.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_ES.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_GT.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_HN.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_MX.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_NI.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_PA.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_PE.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_PR.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_PY.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_SV.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_US.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_UY.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("es_VE.UTF-8", ["jue", "vie", "sáb", "dom", "lun", "mar", "mié"]), + ("et_EE.UTF-8", ["N", "R", "L", "P", "E", "T", "K"]), + ("eu_ES.UTF-8", ["og.", "or.", "lr.", "ig.", "al.", "ar.", "az."]), + ("eu_FR.UTF-8", ["og.", "or.", "lr.", "ig.", "al.", "ar.", "az."]), +-- TODO: lexical error in Haskell +-- ("fa_IR", ["پنجشنبه", "جمعه", "شنبه", "یکشنبه", "دوشنبه", "سه‌شنبه", "چهارشنبه"]), + ("ff_SN", ["naa", "mwd", "hbi", "dew", "aaɓ", "maw", "nje"]), + ("fi_FI.UTF-8", ["to", "pe", "la", "su", "ma", "ti", "ke"]), + ("fil_PH", ["Huw", "Biy", "Sab", "Lin", "Lun", "Mar", "Miy"]), + ("fo_FO.UTF-8", ["hós", "frí", "ley", "sun", "mán", "týs", "mik"]), + ("fr_BE.UTF-8", ["jeu", "ven", "sam", "dim", "lun", "mar", "mer"]), + ("fr_CA.UTF-8", ["jeu", "ven", "sam", "dim", "lun", "mar", "mer"]), + ("fr_CH.UTF-8", ["jeu", "ven", "sam", "dim", "lun", "mar", "mer"]), + ("fr_FR.UTF-8", ["jeu.", "ven.", "sam.", "dim.", "lun.", "mar.", "mer."]), + ("fr_LU.UTF-8", ["jeu", "ven", "sam", "dim", "lun", "mar", "mer"]), + ("fur_IT", ["Joi", "Vin", "Sab", "Dom", "Lun", "Mar", "Mia"]), + ("fy_NL", ["To", "Fr", "Sn", "Sn", "Mo", "Ti", "Wo"]), + ("fy_DE", ["Ddg", "Fdg", "Swd", "Sdg", "Mdg", "Dsg", "Mwk"]), + ("ga_IE.UTF-8", ["Déar", "Aoine", "Sath", "Domh", "Luan", "Máirt", "Céad"]), + ("gd_GB.UTF-8", ["Diar", "Diha", "Disa", "Dido", "Dilu", "Dim", "Dic"]), + ("gez_ER", ["ሐሙስ", "ዓርበ", "ቀዳሚ", "እኁድ", "ሰኑይ", "ሠሉስ", "ራብዕ"]), + ("gez_ER@abegede", ["ሐሙስ", "ዓርበ", "ቀዳሚ", "እኁድ", "ሰኑይ", "ሠሉስ", "ራብዕ"]), + ("gez_ET", ["ሐሙስ", "ዓርበ", "ቀዳሚ", "እኁድ", "ሰኑይ", "ሠሉስ", "ራብዕ"]), + ("gez_ET@abegede", ["ሐሙስ", "ዓርበ", "ቀዳሚ", "እኁድ", "ሰኑይ", "ሠሉስ", "ራብዕ"]), + ("gl_ES.UTF-8", ["Xov", "Ven", "Sáb", "Dom", "Lun", "Mar", "Mér"]), + ("gu_IN", ["ગુરુ", "શુક્ર", "શનિ", "રવિ", "સોમ", "મંગળ", "બુધ"]), + ("gv_GB.UTF-8", ["Jerd", "Jeh", "Jes", "Jed", "Jel", "Jem", "Jerc"]), + ("ha_NG", ["Alh", "Jum", "Asa", "Lah", "Lit", "Tal", "Lar"]), + ("he_IL.UTF-8", ["ה'", "ו'", "ש'", "א'", "ב'", "ג'", "ד'"]), + ("hi_IN", ["गुरु ", "शुक्र ", "शनि ", "रवि ", "सोम ", "मंगल ", "बुध "]), + ("hne_IN", ["बिर ", "सुक", "सनि", "इत ", "सोम ", "मंग ", "बुध "]), + ("hr_HR.UTF-8", ["Čet", "Pet", "Sub", "Ned", "Pon", "Uto", "Sri"]), + ("hsb_DE.UTF-8", ["Št", "Pj", "So", "Nj", "Pó", "Wu", "Sr"]), + ("ht_HT", ["jEd.", "van.", "sam.", "dim.", "lEn.", "mad.", "mèk."]), + ("hu_HU.UTF-8", ["cs", "p", "szo", "v", "h", "k", "sze"]), + ("hy_AM", ["Հնգ", "Ուր", "Շբթ", "Կրկ", "Երկ", "Երք", "Չրք"]), + ("ia", ["jov", "ven", "sab", "dom", "lun", "mar", "mer"]), + ("id_ID.UTF-8", ["Kam", "Jum", "Sab", "Min", "Sen", "Sel", "Rab"]), + ("ig_NG", ["tọs", "fra", "sat", "sọn", "mọn", "tuz", "wen"]), + ("ik_CA", ["Sis", "Tal", "Maq", "Min", "Sav", "Ila", "Qit"]), + ("is_IS.UTF-8", ["fim", "fös", "lau", "sun", "mán", "þri", "mið"]), + ("it_CH.UTF-8", ["gio", "ven", "sab", "dom", "lun", "mar", "mer"]), + ("it_IT.UTF-8", ["gio", "ven", "sab", "dom", "lun", "mar", "mer"]), + ("iu_CA", ["ᕿ", "ᐅ", "ᓯ", "ᓈ", "ᓇ", "ᓕ", "ᐱ"]), + ("iw_IL.UTF-8", ["ה'", "ו'", "ש'", "א'", "ב'", "ג'", "ד'"]), + ("ja_JP.UTF-8", ["木", "金", "土", "日", "月", "火", "水"]), + ("ka_GE.UTF-8", ["ხუთ", "პარ", "შაბ", "კვი", "ორშ", "სამ", "ოთხ"]), + ("kk_KZ.UTF-8", ["Бс", "Жм", "Сн", "Жк", "Дс", "Сс", "Ср"]), + ("kl_GL.UTF-8", ["sis", "tal", "arf", "sab", "ata", "mar", "pin"]), + ("km_KH", ["ព្រ", "សុ", "ស", "អា", "ច", "អ", "ពុ"]), + ("kn_IN", ["ಗು", "ಶು", "ಶ", "ರ", "ಸೋ", "ಮಂ", "ಬು"]), + ("ko_KR.UTF-8", ["목", "금", "토", "일", "월", "화", "수"]), + ("kok_IN", ["बेरेसतार", "शुकरार", "शेनवार", "आयतार", "सोमार", "मंगळवार", "बुधवार"]), + ("ks_IN", ["برىسوار", "جمع", "بٹوار", "آتهوار", "ژءنتروار", "بوءںوار", "بودهوار"]), + ("ks_IN@devanagari", ["ब्रस््", "जुम", "बट", "आथ्", "चन्दर्", "बोम्", "बोघ"]), + ("ku_TR.UTF-8", ["Pş", "În", "Ş", "Yş", "Dş", "Sş", "Çş"]), + ("kw_GB.UTF-8", ["Yow", "Gwe", "Sad", "Sul", "Lun", "Mth", "Mhr"]), + ("ky_KG", ["бш", "жм", "иш", "жк", "дш", "ше", "ша"]), + ("lg_UG.UTF-8", ["Lw4", "Lw5", "Lw6", "Sab", "Bal", "Lw2", "Lw3"]), +-- TODO: lexical error in Haskell +-- ("li_BE", ["dón", "vri", "z‘o", "zón", "mao", "dae", "goo"]), +-- ("li_NL", ["dón", "vri", "z‘o", "zón", "mao", "dae", "goo"]), + ("lo_LA", ["ພຫ.", "ສ.", "ສ.", "ອາ.", "ຈ.", "ຄ.", "ພ."]), + ("lt_LT.UTF-8", ["Kt", "Pn", "Št", "Sk", "Pr", "An", "Tr"]), + ("lv_LV.UTF-8", ["C ", "Pk", "S ", "Sv", "P ", "O ", "T "]), + ("mai_IN", ["गुरु ", "शुक्र ", "शनि ", "रवि ", "सोम ", "मंगल ", "बुध "]), + ("mg_MG.UTF-8", ["lkm", "zom", "sab", "lhd", "lts", "tlt", "lrb"]), + ("mi_NZ.UTF-8", ["Tāi", "Pa", "Hā", "Ta", "Ma", "Tū", "We"]), + ("mk_MK.UTF-8", ["чет", "пет", "саб", "нед", "пон", "вто", "сре"]), + ("ml_IN", ["വ്യാ", "വെ", "ശ", "ഞാ", "തി", "ചൊ", "ബു"]), + ("mn_MN", ["Пү", "Ба", "Бя", "Ня", "Да", "Мя", "Лх"]), + ("mr_IN", ["गुरु", "शुक्र", "शनि", "रवि", "सोम", "मंगळ", "बुध"]), + ("ms_MY.UTF-8", ["Kha", "Jum", "Sab", "Ahd", "Isn", "Sel", "Rab"]), + ("mt_MT.UTF-8", ["Ħam", "Ġim", "Sib", "Ħad", "Tne", "Tli", "Erb"]), + ("my_MM", ["တေး", "သော", "နေ", "နွေ", "လာ", "ဂါ", "ဟူး"]), + ("nan_TW@latin", ["p4", "p5", "p6", "lp", "p1", "p2", "p3"]), + ("nb_NO.UTF-8", ["to.", "fr.", "lø.", "sø.", "ma.", "ti.", "on."]), + ("nds_DE", ["Dunn", "Free", "Svd.", "Sdag", "Maan", "Ding", "Migg"]), + ("nds_NL", ["Ddg", "Fdg", "Swd", "Sdg", "Mdg", "Dsg", "Mwk"]), + ("ne_NP", ["बिहि ", "शुक्र ", "शनि ", "आइत ", "सोम ", "मंगल ", "बुध "]), + ("nl_AW", ["do", "vr", "za", "zo", "ma", "di", "wo"]), + ("nl_BE.UTF-8", ["do", "vr", "za", "zo", "ma", "di", "wo"]), + ("nl_NL.UTF-8", ["do", "vr", "za", "zo", "ma", "di", "wo"]), + ("nn_NO.UTF-8", ["to.", "fr.", "la.", "su.", "må.", "ty.", "on."]), + ("nr_ZA", ["Ne", "Hla", "Gqi", "Son", "Mvu", "Bil", "Tha"]), + ("nso_ZA", ["Ne", "Hla", "Mok", "Son", "Moš", "Bed", "Rar"]), + ("oc_FR.UTF-8", ["jòu", "ven", "sab", "dim", "lun", "mar", "mec"]), + ("om_ET", ["Kam", "Jim", "San", "Dil", "Wix", "Qib", "Rob"]), + ("om_KE.UTF-8", ["Kam", "Jim", "San", "Dil", "Wix", "Qib", "Rob"]), + ("or_IN", ["ଗୁରୁ", "ଶୁକ୍ର", "ଶନି", "ରବି", "ସୋମ", "ମଙ୍ଗଳ", "ବୁଧ"]), + ("os_RU", ["Цпр", "Мрб", "Сбт", "Хцб", "Крс", "Дцг", "Æрт"]), + ("pa_IN", ["ਵੀਰ ", "ਸ਼ੁੱਕਰ ", "ਸ਼ਨਿੱਚਰ ", "ਐਤ ", "ਸੋਮ ", "ਮੰਗਲ ", "ਬੁੱਧ "]), + ("pa_PK", ["جمعرات", "جمعه", "هفته", "اتوار", "پير", "منگل", "بدھ"]), + ("pap_AN", ["ra", "bi", "sa", "do", "lu", "ma", "we"]), + ("pl_PL.UTF-8", ["czw", "pią", "sob", "nie", "pon", "wto", "śro"]), + ("ps_AF", ["پ.", "ج.", "ش.", "ی.", "د.", "س.", "چ."]), + ("pt_BR.UTF-8", ["Qui", "Sex", "Sáb", "Dom", "Seg", "Ter", "Qua"]), + ("pt_PT.UTF-8", ["Qui", "Sex", "Sáb", "Dom", "Seg", "Ter", "Qua"]), + ("ro_RO.UTF-8", ["Jo", "Vi", "Sb", "Du", "Lu", "Ma", "Mi"]), + ("ru_RU.UTF-8", ["Чтв", "Птн", "Сбт", "Вск", "Пнд", "Втр", "Срд"]), + ("ru_UA.UTF-8", ["Чтв", "Птн", "Суб", "Вск", "Пнд", "Вто", "Срд"]), + ("rw_RW", ["Kan", "Gnu", "Gnd", "Mwe", "Mbe", "Kab", "Gtu"]), + ("sa_IN", ["बृहस्पतिः", "शुक्र", "शनि:", "रविः", "सोम:", "मंगल:", "बुध:"]), + ("sc_IT", ["Jòb", "Cen", "Sàb", "Dom", "Lun", "Mar", "Mèr"]), + ("sd_IN", ["وسپت", "جُمو", "ڇنڇر", "آرتوارُ", "سومرُ", "منگلُ", "ٻُڌرُ"]), + ("sd_IN@devanagari", ["विस्पति", "जुमो", "छंछस", "आर्तवारू", "सूमरू", "मंगलू", "ॿुधरू"]), + ("se_NO", ["duor", "bear", "láv", "sotn", "vuos", "maŋ", "gask"]), + ("shs_CA", ["Sme", "Sts", "Stq", "Sxe", "Spe", "Sel", "Ske"]), +-- TODO: lexical error in Haskell +-- ("si_LK", ["බ්‍ර", "සි", "සෙ", "ඉ", "ස", "අ", "බ"]), + ("sid_ET", ["Ham", "Arb", "Qid", "Sam", "San", "Mak", "Row"]), + ("sk_SK.UTF-8", ["Št", "Pi", "So", "Ne", "Po", "Ut", "St"]), + ("sl_SI.UTF-8", ["čet", "pet", "sob", "ned", "pon", "tor", "sre"]), + ("so_DJ.UTF-8", ["kha", "jim", "sab", "axa", "isn", "sal", "arb"]), + ("so_ET", ["Kha", "Jim", "Sab", "Axa", "Isn", "Sal", "Arb"]), + ("so_KE.UTF-8", ["Kha", "Jim", "Sab", "Axa", "Isn", "Sal", "Arb"]), + ("so_SO.UTF-8", ["Kha", "Jim", "Sab", "Axa", "Isn", "Sal", "Arb"]), + ("sq_AL.UTF-8", ["Enj ", "Pre ", "Sht ", "Die ", "Hën ", "Mar ", "Mër "]), + ("sq_MK", ["Enj ", "Pre ", "Sht ", "Die ", "Hën ", "Mar ", "Mër "]), + ("sr_ME", ["чет", "пет", "суб", "нед", "пон", "уто", "сри"]), + ("sr_RS", ["чет", "пет", "суб", "нед", "пон", "уто", "сре"]), + ("sr_RS@latin", ["čet", "pet", "sub", "ned", "pon", "uto", "sre"]), + ("ss_ZA", ["Ne", "Hla", "Mgc", "Son", "Mso", "Bil", "Tsa"]), + ("st_ZA.UTF-8", ["Ne", "Hla", "Moq", "Son", "Mma", "Bed", "Rar"]), + ("sv_FI.UTF-8", ["tor", "fre", "lör", "sön", "mån", "tis", "ons"]), + ("sv_SE.UTF-8", ["tor", "fre", "lör", "sön", "mån", "tis", "ons"]), + ("sw_KE", ["Alh", "Ij", "J1", "J2", "J3", "J4", "J5"]), + ("sw_TZ", ["Alh", "Ij", "J1", "J2", "J3", "J4", "J5"]), + ("ta_IN", ["வி", "வெ", "ச", "ஞா", "தி", "செ", "பு"]), + ("te_IN", ["గురు", "శుక్ర", "శని", "ఆది", "సోమ", "మంగళ", "బుధ"]), + ("tg_TJ.UTF-8", ["Чтв", "Птн", "Сбт", "Вск", "Пнд", "Втр", "Срд"]), + ("th_TH.UTF-8", ["พฤ.", "ศ.", "ส.", "อา.", "จ.", "อ.", "พ."]), + ("ti_ER", ["ሓሙስ", "ዓርቢ", "ቀዳም", "ሰንበ", "ሰኑይ", "ሰሉስ", "ረቡዕ"]), + ("ti_ET", ["ሓሙስ", "ዓርቢ", "ቀዳም", "ሰንበ", "ሰኑይ", "ሰሉስ", "ረቡዕ"]), + ("tig_ER", ["ከሚሽ", "ጅምዓ", "ሰ/ን", "ሰ/ዓ", "ሰኖ ", "ታላሸ", "ኣረር"]), + ("tk_TM", ["Sog", "Ann", "Ruh", "Dyn", "Baş", "Yaş", "Hoş"]), + ("tl_PH.UTF-8", ["Huw", "Biy", "Sab", "Lin", "Lun", "Mar", "Miy"]), + ("tn_ZA", ["Ne", "Tlh", "Mat", "Tsh", "Mos", "Bed", "Rar"]), + ("tr_CY.UTF-8", ["Prş", "Cum", "Cts", "Paz", "Pzt", "Sal", "Çrş"]), + ("tr_TR.UTF-8", ["Prş", "Cum", "Cts", "Paz", "Pzt", "Sal", "Çrş"]), + ("ts_ZA", ["Ne", "Tlh", "Mug", "Son", "Mus", "Bir", "Har"]), + ("tt_RU.UTF-8", ["Пәнҗ", "Җом", "Шим", "Якш", "Дыш", "Сиш", "Чәрш"]), + ("tt_RU.UTF-8@iqtelif", ["Pen", "Com", "Şim", "Yek", "Düş", "Siş", "Çer"]), + ("ug_CN", ["Thu", "Fri", "Sat", "Sun", "Mon", "Tue", "Wed"]), + ("uk_UA.UTF-8", ["чт", "пт", "сб", "нд", "пн", "вт", "ср"]), + ("ur_PK", ["جمعرات", "جمعه", "هفته", "اتوار", "پير", "منگل", "بدھ"]), + ("uz_UZ.UTF-8", ["Pay", "Ju", "Sha", "Yak", "Du", "Se", "Cho"]), + ("uz_UZ@cyrillic", ["Пай", "Жум", "Шан", "Якш", "Душ", "Сеш", "Чор"]), + ("ve_ZA", ["ṋa", "Ṱan", "Mug", "Swo", "Mus", "Vhi", "Rar"]), + ("vi_VN", ["T5", "T6", "T7", "CN", "T2", "T3", "T4"]), + ("wa_BE.UTF-8", ["dju", "vén", "sem", "dim", "lon", "mår", "mie"]), + ("wo_SN", ["alx", "ajj", "gaa", "dib", "alt", "tal", "all"]), + ("xh_ZA.UTF-8", ["Sin", "Hla", "Mgq", "Caw", "Mvu", "Bin", "Tha"]), + ("yi_US.UTF-8", ["דאָנ'", "פֿרײַ'", "שבת", "זונ'", "מאָנ'", "דינ'", "מיט'"]), + ("yo_NG", ["THU", "FRI", "SAT", "SUN", "MON", "TUE", "WED"]), + ("zh_CN.UTF-8", ["四", "五", "六", "日", "一", "二", "三"]), + ("zh_HK.UTF-8", ["四", "五", "六", "日", "一", "二", "三"]), + ("zh_SG.UTF-8", ["星期四", "星期五", "星期六", "星期日", "星期一", "星期二", "星期三"]), + ("zh_TW.UTF-8", ["四", "五", "六", "日", "一", "二", "三"]), + ("zu_ZA.UTF-8", ["Sin", "Hla", "Mgq", "Son", "Mso", "Bil", "Tha"]) + ]