org-mode (empty) → 1.0.0
raw patch · 6 files changed
+782/−0 lines, 6 filesdep +basedep +filepathdep +hashable
Dependencies added: base, filepath, hashable, megaparsec, org-mode, parser-combinators, tasty, tasty-hunit, text, time
Files
- CHANGELOG.md +7/−0
- LICENSE +30/−0
- README.md +17/−0
- lib/Data/Org.hs +488/−0
- org-mode.cabal +47/−0
- test/Test.hs +193/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Changelog++## 1.0.0 (2020-03-05)++#### Added++- Initial version of all types, parsers, and pretty-printers.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Colin Woodbury (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,17 @@+# org-mode++`org-mode` is a library for parsing text in the [Emacs+org-mode](https://orgmode.org/) format.++## Assumptions++- File metadata appears at the top of the file in a specific order.++## Unimplemented++The following don't parse as of yet:++- Table Formulas+- Heading tags+- Certain top-level document metadata+- Anything involving the TODO system or clocking-in
+ lib/Data/Org.hs view
@@ -0,0 +1,488 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}++-- |+-- Module : Data.Org+-- Copyright : (c) Colin Woodbury, 2020+-- License : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- This library parses text in the <https://orgmode.org/ Emacs Org Mode> format.+--+-- Use the `org` function to parse a `T.Text` value.++module Data.Org+ ( -- * Types+ OrgFile(..)+ , emptyOrgFile+ , Meta(..)+ , emptyMeta+ , OrgDoc(..)+ , emptyDoc+ , Section(..)+ , Block(..)+ , Words(..)+ , ListItems(..)+ , Item(..)+ , Row(..)+ , Column(..)+ , URL(..)+ , Language(..)+ -- * Parsing+ , org+ -- ** Internal Parsers+ -- | These are exposed for testing purposes.+ , orgFile+ , meta+ , orgP+ , section+ , paragraph+ , table+ , list+ , line+ -- * Pretty Printing+ , prettyOrgFile+ , prettyOrg+ , prettyWords+ ) where++import Control.Applicative.Combinators.NonEmpty+import Control.Monad (void, when)+import Data.Functor (($>))+import Data.Hashable (Hashable(..))+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NEL+import Data.Semigroup (sconcat)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Calendar (Day, fromGregorian, toGregorian)+import Data.Void (Void)+import GHC.Generics (Generic)+import System.FilePath (takeExtension)+import Text.Megaparsec hiding (sepBy1, sepEndBy1, some, someTill)+import Text.Megaparsec.Char+import qualified Text.Megaparsec.Char.Lexer as L+import Text.Printf (printf)++--------------------------------------------------------------------------------+-- Types++-- | A complete @.org@ file with metadata.+data OrgFile = OrgFile+ { orgMeta :: Meta+ , orgDoc :: OrgDoc }+ deriving stock (Eq, Show, Generic)++emptyOrgFile :: OrgFile+emptyOrgFile = OrgFile emptyMeta emptyDoc++-- | Top-level fields like:+--+-- @+-- #+TITLE: Curing Cancer with Haskell+-- #+DATE: 2020-02-25+-- #+AUTHOR: Colin+-- @+data Meta = Meta+ { metaTitle :: Maybe Text+ , metaDate :: Maybe Day+ , metaAuthor :: Maybe Text+ , metaHtmlHead :: Maybe Text+ , metaOptions :: Maybe Text }+ deriving stock (Eq, Show, Generic)++emptyMeta :: Meta+emptyMeta = Meta Nothing Nothing Nothing Nothing Nothing++-- | A recursive Org document. These are zero or more blocks of markup, followed+-- by zero or more subsections.+--+-- @+-- This is some top-level text.+--+-- * Important heading+--+-- ** Less important subheading+-- @+data OrgDoc = OrgDoc+ { docBlocks :: [Block]+ , docSections :: [Section] }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++emptyDoc :: OrgDoc+emptyDoc = OrgDoc [] []++-- | Some logically distinct block of Org content.+data Block+ = Quote Text+ | Example Text+ | Code (Maybe Language) Text+ | List ListItems+ | Table (NonEmpty Row)+ | Paragraph (NonEmpty Words)+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++-- | A subsection, marked by a heading line and followed recursively by an+-- `OrgDoc`.+--+-- @+-- * This is a Heading+--+-- This is content in the sub ~OrgDoc~.+-- @+data Section = Section+ { sectionHeading :: NonEmpty Words+ , sectionDoc :: OrgDoc }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++-- | An org list constructed of @-@ characters.+--+-- @+-- - Feed the cat+-- - The good stuff+-- - Feed the dog+-- - He'll eat anything+-- - Feed the bird+-- - Feed the alligator+-- - Feed the elephant+-- @+newtype ListItems = ListItems (NonEmpty Item)+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++-- | A line in a bullet-list. Can contain sublists, as shown in `ListItems`.+data Item = Item (NonEmpty Words) (Maybe ListItems)+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++-- | A row in an org table. Can have content or be a horizontal rule.+--+-- @+-- | A | B | C |+-- |---+---+---|+-- | D | E | F |+-- @+data Row = Break | Row (NonEmpty Column)+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++-- | A possibly empty column in an org table.+data Column = Empty | Column (NonEmpty Words)+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++-- | The fundamental unit of Org text content. `Plain` units are split+-- word-by-word.+data Words+ = Bold Text+ | Italic Text+ | Highlight Text+ | Underline Text+ | Verbatim Text+ | Strike Text+ | Link URL (Maybe Text)+ | Image URL+ | Punct Char+ | Plain Text+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++-- | The url portion of a link.+newtype URL = URL Text+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++-- | The programming language some source code block was written in.+newtype Language = Language Text+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Hashable)++--------------------------------------------------------------------------------+-- Parser++-- | Attempt to parse an `OrgFile`.+org :: Text -> Maybe OrgFile+org = parseMaybe orgFile++type Parser = Parsec Void Text++orgFile :: Parser OrgFile+orgFile = space *> L.lexeme space (OrgFile <$> meta <*> orgP) <* eof++meta :: Parser Meta+meta = L.lexeme space $ Meta+ <$> optional (string "#+TITLE: " *> someTillEnd <* space)+ <*> optional (string "#+DATE: " *> date <* space)+ <*> optional (string "#+AUTHOR: " *> someTillEnd <* space)+ <*> optional (string "#+HTML_HEAD: " *> someTillEnd <* space)+ <*> optional (string "#+OPTIONS: " *> someTillEnd <* space)+ where+ date :: Parser Day+ date = fromGregorian+ <$> (L.decimal <* char '-')+ <*> (L.decimal <* char '-')+ <*> L.decimal++orgP :: Parser OrgDoc+orgP = orgP' 1++orgP' :: Int -> Parser OrgDoc+orgP' depth = L.lexeme space $ OrgDoc+ <$> many block+ <*> many (try $ section depth)+ where+ block :: Parser Block+ block = choice+ [ try code+ , try example+ , try quote+ , try list+ , try table+ , paragraph ] -- TODO Paragraph needs to fail if it detects a heading.++-- | If a line stars with @*@ and a space, it is a `Section` heading.+heading :: Parser (T.Text, NonEmpty Words)+heading = (,)+ <$> someOf '*' <* char ' '+ <*> line '\n'++section :: Int -> Parser Section+section depth = L.lexeme space $ do+ (stars, ws) <- heading+ -- Fail if we've found a parent heading --+ when (T.length stars < depth) $ failure Nothing mempty+ -- Otherwise continue --+ void space+ Section ws <$> orgP' (succ depth)++quote :: Parser Block+quote = L.lexeme space $ do+ void top <* newline+ ls <- manyTill (manyTillEnd <* newline) bot+ pure . Quote $ T.intercalate "\n" ls+ where+ top = string "#+" *> (string "BEGIN_QUOTE" <|> string "begin_quote")+ bot = string "#+" *> (string "END_QUOTE" <|> string "end_quote")++example :: Parser Block+example = L.lexeme space $ do+ void top <* newline+ ls <- manyTill (manyTillEnd <* newline) bot+ pure . Example $ T.intercalate "\n" ls+ where+ top = string "#+" *> (string "BEGIN_EXAMPLE" <|> string "begin_example")+ bot = string "#+" *> (string "END_EXAMPLE" <|> string "end_example")++code :: Parser Block+code = L.lexeme space $ do+ lang <- top *> optional lng <* newline+ ls <- manyTill (manyTillEnd <* newline) bot+ pure . Code (Language <$> lang) $ T.intercalate "\n" ls+ where+ top = string "#+" *> (string "BEGIN_SRC" <|> string "begin_src")+ bot = string "#+" *> (string "END_SRC" <|> string "end_src")+ lng = char ' ' *> someTillEnd++list :: Parser Block+list = L.lexeme space $ List <$> listItems 0++listItems :: Int -> Parser ListItems+listItems indent = ListItems+ <$> sepBy1 (item indent) (try $ newline *> lookAhead (nextItem indent))++nextItem :: Int -> Parser ()+nextItem indent = do+ void . string $ T.replicate indent " "+ void $ string "- "++-- | Conditions for ending the current bullet:+--+-- 1. You find two '\n' at the end of a line.+-- 2. The first two non-space characters of the next line are "- ".+item :: Int -> Parser Item+item indent = do+ leading <- string $ T.replicate indent " "+ void $ string "- "+ l <- bullet+ let !nextInd = T.length leading + 2+ Item l <$> optional (try $ newline *> listItems nextInd)+ where+ bullet :: Parser (NonEmpty Words)+ bullet = do+ l <- line '\n'+ try (lookAhead keepGoing *> space *> ((l <>) <$> bullet)) <|> pure l++ keepGoing :: Parser ()+ keepGoing = void $ char '\n' *> manyOf ' ' *> noneOf ['-', '\n']++table :: Parser Block+table = L.lexeme space $ Table <$> sepEndBy1 row (char '\n')+ where+ row :: Parser Row+ row = do+ void $ char '|'+ brk <|> (Row <$> sepEndBy1 column (char '|'))++ -- | If the line starts with @|-@, assume its a break regardless of what+ -- chars come after that.+ brk :: Parser Row+ brk = char '-' *> manyTillEnd $> Break++ column :: Parser Column+ column = do+ void $ someOf ' '+ (lookAhead (char '|') $> Empty) <|> (Column <$> line '|')++paragraph :: Parser Block+paragraph = L.lexeme space $ do+ notFollowedBy heading+ Paragraph . sconcat <$> sepEndBy1 (line '\n') newline++line :: Char -> Parser (NonEmpty Words)+line end = sepEndBy1 (wordChunk end) (manyOf ' ')++-- | RULES+--+-- 1. In-lined markup is not recognized: This is not*bold*. Neither is *this*here.+-- 2. Punctuation immediately after markup close /is/ allowed: *This*, in fact, is bold.+-- 3. Otherwise, a space, newline or EOF is necessary after the close.+-- 4. Any char after a link is fine.+-- 5. When rerendering, a space must not appear between the end of a markup close and+-- a punctuation/newline character.+-- 6. But any other character must have a space before it.+wordChunk :: Char -> Parser Words+wordChunk end = choice+ [ try $ Bold <$> between (char '*') (char '*') (someTill' '*') <* pOrS+ , try $ Italic <$> between (char '/') (char '/') (someTill' '/') <* pOrS+ , try $ Highlight <$> between (char '~') (char '~') (someTill' '~') <* pOrS+ , try $ Verbatim <$> between (char '=') (char '=') (someTill' '=') <* pOrS+ , try $ Underline <$> between (char '_') (char '_') (someTill' '_') <* pOrS+ , try $ Strike <$> between (char '+') (char '+') (someTill' '+') <* pOrS+ , try image+ , try link+ , try $ Punct <$> oneOf punc+ , Plain <$> takeWhile1P (Just "plain text") (\c -> c /= ' ' && c /= end) ]+ where+ pOrS :: Parser ()+ pOrS = lookAhead $ void (oneOf $ end : ' ' : punc) <|> eof++punc :: String+punc = ".,!?():;'"++image :: Parser Words+image = between (char '[') (char ']') $+ between (char '[') (char ']') $ do+ path <- someTill' ']'+ let !ext = takeExtension $ T.unpack path+ when (ext `notElem` [".jpg", ".jpeg", ".png"]) $ failure Nothing mempty+ pure . Image $ URL path++link :: Parser Words+link = between (char '[') (char ']') $ Link+ <$> between (char '[') (char ']') (URL <$> someTill' ']')+ <*> optional (between (char '[') (char ']') (someTill' ']'))++someTillEnd :: Parser Text+someTillEnd = someTill' '\n'++manyTillEnd :: Parser Text+manyTillEnd = takeWhileP (Just "many until the end of the line") (/= '\n')++someTill' :: Char -> Parser Text+someTill' c = takeWhile1P (Just $ "some until " <> [c]) (/= c)++-- | Fast version of `some` specialized to `Text`.+someOf :: Char -> Parser Text+someOf c = takeWhile1P (Just $ "some of " <> [c]) (== c)++manyOf :: Char -> Parser Text+manyOf c = takeWhileP (Just $ "many of " <> [c]) (== c)++--------------------------------------------------------------------------------+-- Pretty Printing++prettyOrgFile :: OrgFile -> Text+prettyOrgFile (OrgFile m os) = metas <> "\n\n" <> prettyOrg os+ where+ metas = T.intercalate "\n" $+ maybe [] (\t -> ["#+TITLE: " <> t]) (metaTitle m)+ <> maybe [] (pure . T.pack . day) (metaDate m)+ <> maybe [] (\a -> ["#+AUTHOR: " <> a]) (metaAuthor m)+ <> maybe [] (\h -> ["#+HTML_HEAD: " <> h]) (metaHtmlHead m)++ day :: Day -> String+ day d = case toGregorian d of+ (yr, mn, dy) -> printf "#+DATE: %d-%02d-%02d" yr mn dy++prettyOrg :: OrgDoc -> Text+prettyOrg = prettyOrg' 1++prettyOrg' :: Int -> OrgDoc -> Text+prettyOrg' depth (OrgDoc bs ss) =+ T.intercalate "\n\n" $ map prettyBlock bs <> map (prettySection depth) ss++prettySection :: Int -> Section -> Text+prettySection depth (Section ws od) = headig <> "\n\n" <> subdoc+ where+ headig = T.unwords $ T.replicate depth "*" : NEL.toList (NEL.map prettyWords ws)+ subdoc = prettyOrg' (succ depth) od++prettyBlock :: Block -> Text+prettyBlock o = case o of+ Code l t -> "#+begin_src" <> maybe "" (\(Language l') -> " " <> l' <> "\n") l+ <> t+ <> "\n#+end_src"+ Quote t -> "#+begin_quote\n" <> t <> "\n#+end_quote"+ Example t -> "#+begin_example\n" <> t <> "\n#+end_example"+ Paragraph ht -> par ht+ List items -> lis 0 items+ Table rows -> T.intercalate "\n" . map row $ NEL.toList rows+ where+ lis :: Int -> ListItems -> Text+ lis indent (ListItems is) = T.intercalate "\n" . map (f indent) $ NEL.toList is++ f :: Int -> Item -> Text+ f indent (Item ws li) =+ T.replicate indent " " <> "- " <> par ws+ <> maybe "" (\is -> "\n" <> lis (indent + 2) is) li++ par :: NonEmpty Words -> Text+ par (h :| t) = prettyWords h <> para h t++ -- | Stick punctuation directly behind the chars in front of it, while+ -- paying special attention to parentheses.+ para :: Words -> [Words] -> Text+ para _ [] = ""+ para pr (w:ws) = case pr of+ Punct '(' -> prettyWords w <> para w ws+ _ -> case w of+ Punct '(' -> " " <> prettyWords w <> para w ws+ Punct _ -> prettyWords w <> para w ws+ _ -> " " <> prettyWords w <> para w ws++ row :: Row -> Text+ row Break = "|-|"+ row (Row cs) = "| " <> (T.intercalate " | " . map col $ NEL.toList cs) <> " |"++ col :: Column -> Text+ col Empty = ""+ col (Column ws) = T.unwords . map prettyWords $ NEL.toList ws++prettyWords :: Words -> Text+prettyWords w = case w of+ Bold t -> "*" <> t <> "*"+ Italic t -> "/" <> t <> "/"+ Highlight t -> "~" <> t <> "~"+ Underline t -> "_" <> t <> "_"+ Verbatim t -> "=" <> t <> "="+ Strike t -> "+" <> t <> "+"+ Link (URL url) Nothing -> "[[" <> url <> "]]"+ Link (URL url) (Just t) -> "[[" <> url <> "][" <> t <> "]]"+ Image (URL url) -> "[[" <> url <> "]]"+ Punct c -> T.singleton c+ Plain t -> t
+ org-mode.cabal view
@@ -0,0 +1,47 @@+cabal-version: 2.2+name: org-mode+version: 1.0.0+description: Parser for Emacs org-mode files.+homepage: https://github.com/fosskers/org-mode+author: Colin Woodbury+maintainer: colin@fosskers.ca+copyright: 2020 Colin Woodbury+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++common commons+ default-language: Haskell2010+ default-extensions: OverloadedStrings+ ghc-options:+ -Wall -Wpartial-fields -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Widentities++ build-depends:+ , base >=4.12 && <5+ , megaparsec >=7 && <9+ , text+ , time >=1.8 && <1.10++library+ import: commons+ hs-source-dirs: lib+ exposed-modules: Data.Org+ build-depends:+ , filepath+ , hashable >=1.2 && <1.4+ , parser-combinators >=1.1 && <1.3++test-suite org-mode-test+ import: commons+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Test.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ , org-mode+ , tasty ^>=1.2+ , tasty-hunit ^>=0.10
+ test/Test.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedLists #-}++module Main where++import Data.Org+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Data.Time.Calendar (fromGregorian)+import Data.Void (Void)+import Test.Tasty+import Test.Tasty.HUnit+import Text.Megaparsec+import Text.Megaparsec.Char++---++main :: IO ()+main = do+ simple <- T.readFile "test/simple.org"+ full <- T.readFile "test/test.org"+ let fl = parseMaybe orgFile full+ -- pPrintNoColor fl+ maybe (putStrLn "COULDN'T PARSE") T.putStrLn $ prettyOrgFile <$> fl+ defaultMain $ suite simple full++suite :: T.Text -> T.Text -> TestTree+suite simple full = testGroup "Unit Tests"+ [ testGroup "Basic Markup"+ [ testCase "Header" $ parseMaybe (section 1) "* A"+ @?= Just (Section [Plain "A"] emptyDoc)+ , testCase "Header - Subsection" $ parseMaybe (section 1) "* A\n** B"+ @?= Just (Section [Plain "A"] (OrgDoc [] [Section [Plain "B"] emptyDoc]))+ , testCase "Header - Back again"+ $ testPretty orgP "Header" "* A\n** B\n* C"+ $ OrgDoc [] [ Section [Plain "A"] (OrgDoc [] [Section [Plain "B"] emptyDoc])+ , Section [Plain "C"] emptyDoc ]+ , testCase "Header - Contents"+ $ testPretty orgP "Header" "* A\nD\n\n** B\n* C" -- TODO Requires an extra newline!+ $ OrgDoc []+ [ Section [Plain "A"] (OrgDoc [Paragraph [Plain "D"]] [Section [Plain "B"] emptyDoc])+ , Section [Plain "C"] emptyDoc ]++ , testCase "Bold" $ parseMaybe orgP "*Bold*"+ @?= Just (OrgDoc [Paragraph [Bold "Bold"]] [])+ , testCase "Italics" $ parseMaybe orgP "/Italic/"+ @?= Just (OrgDoc [Paragraph [Italic "Italic"]] [])+ , testCase "Highlight" $ parseMaybe orgP "~Highlight~"+ @?= Just (OrgDoc [Paragraph [Highlight "Highlight"]] [])+ , testCase "Verbatim" $ parseMaybe orgP "=Verbatim="+ @?= Just (OrgDoc [Paragraph [Verbatim "Verbatim"]] [])+ , testCase "Underline" $ parseMaybe orgP "_Underline_"+ @?= Just (OrgDoc [Paragraph [Underline "Underline"]] [])+ , testCase "Strike" $ parseMaybe orgP "+Strike+"+ @?= Just (OrgDoc [Paragraph [Strike "Strike"]] [])++ , testCase "Link" $ parseMaybe orgP "[[https://www.fosskers.ca][Site]]"+ @?= Just (OrgDoc [Paragraph [Link (URL "https://www.fosskers.ca") (Just "Site")]] [])+ , testCase "Link (no desc)" $ parseMaybe orgP "[[https://www.fosskers.ca]]"+ @?= Just (OrgDoc [Paragraph [Link (URL "https://www.fosskers.ca") Nothing]] [])++ , testCase "Image" $ parseMaybe orgP "[[/path/to/img.jpeg]]"+ @?= Just (OrgDoc [Paragraph [Image (URL "/path/to/img.jpeg")]] [])+ , testCase "Image - False Positive"+ $ testPretty paragraph "Image" "[[http://a.ca][hi]] [[a.png]]"+ $ Paragraph [Link (URL "http://a.ca") (Just "hi"), Image (URL "a.png")]++ , testCase "Plain" $ parseMaybe orgP "This is a line"+ @?= Just (OrgDoc [Paragraph [Plain "This", Plain "is", Plain "a", Plain "line"]] [])+ ]+ , testGroup "Markup Edge Cases"+ [ testCase "Before" $ parseMaybe orgP "This is *not*bold."+ @?= Just (OrgDoc [Paragraph [Plain "This", Plain "is", Plain "*not*bold."]] [])+ , testCase "After" $ parseMaybe orgP "Neither is *this*here."+ @?= Just (OrgDoc [Paragraph [Plain "Neither", Plain "is", Plain "*this*here."]] [])+ , testCase "Punctuation - Comma" $ parseMaybe orgP "*This*, is bold."+ @?= Just (OrgDoc [Paragraph [Bold "This", Punct ',', Plain "is", Plain "bold."]] [])++ , testCase "Punctuation - Paren" $ parseMaybe orgP "(the ~be~)"+ @?= Just (OrgDoc [Paragraph [Punct '(', Plain "the", Highlight "be", Punct ')']] [])++ , testCase "Punctuation - Double parens"+ $ testPretty paragraph "Parens" "(~Hello~)"+ $ Paragraph [Punct '(', Highlight "Hello", Punct ')']++ , testCase "Line - Plain" $ testPretty (line '\n') "Line" "A" [Plain "A"]+ , testCase "Line - Wide Gap" $ testPretty (line '\n') "Line" "A B"+ [Plain "A", Plain "B"]+ , testCase "Line - Newline" $ testPretty (line '\n') "Line" "A\n" [Plain "A"]+ , testCase "Line - Space at end" $ testPretty (line '\n') "Line" "A \n" [Plain "A"]+ , testCase "Line - Dummy markup symbol" $ testPretty (line '\n') "Line" "A ~ B"+ [Plain "A", Plain "~", Plain "B"]+ ]+ , testGroup "Composite Structures"+ [ testCase "Example" $ parseMaybe orgP "#+begin_example\nHi!\n\nHo\n#+end_example"+ @?= Just (OrgDoc [Example "Hi!\n\nHo"] [])+ , testCase "Example - Empty" $ parseMaybe orgP "#+begin_example\n#+end_example"+ @?= Just (OrgDoc [Example ""] [])+ , testCase "Quote" $ parseMaybe orgP "#+begin_quote\nHi!\n\nHo\n#+end_quote"+ @?= Just (OrgDoc [Quote "Hi!\n\nHo"] [])+ , testCase "Quote - Empty" $ parseMaybe orgP "#+begin_quote\n#+end_quote"+ @?= Just (OrgDoc [Quote ""] [])+ , testCase "Code" $ parseMaybe orgP "#+begin_src haskell\n1 + 1\n#+end_src"+ @?= Just (OrgDoc [Code (Just $ Language "haskell") "1 + 1"] [])+ , testCase "Code - Empty" $ parseMaybe orgP "#+begin_src haskell\n#+end_src"+ @?= Just (OrgDoc [Code (Just $ Language "haskell") ""] [])+ , testCase "Code - No Language" $ parseMaybe orgP "#+begin_src\n1 + 1\n#+end_src"+ @?= Just (OrgDoc [Code Nothing "1 + 1"] [])++ , testCase "List - Single Indent"+ $ testPretty list "List" "- A\n - B"+ $ List (ListItems [Item [Plain "A"] (Just $ ListItems [Item [Plain "B"] Nothing])])++ , testCase "List - Indent and Back"+ $ testPretty list "List" "- A\n - B\n- C"+ $ List (ListItems+ [ Item [Plain "A"] (Just $ ListItems [Item [Plain "B"] Nothing])+ , Item [Plain "C"] Nothing ])++ , testCase "List - Double Indent and Back"+ $ testPretty list "List" "- A\n - B\n - C\n- D"+ $ List (ListItems+ [ Item [Plain "A"] (Just $ ListItems [Item [Plain "B"] Nothing, Item [Plain "C"] Nothing])+ , Item [Plain "D"] Nothing ])++ , testCase "List - Things after" $ parseMaybe orgP "- A\n - B\n- C\n\nD"+ @?= Just (OrgDoc [ List (ListItems+ [ Item [Plain "A"] (Just $ ListItems [Item [Plain "B"] Nothing])+ , Item [Plain "C"] Nothing])+ , Paragraph [Plain "D"]] [])++ , testCase "List - Multiline"+ $ testPretty list "List" "- A\n B\n- C"+ $ List (ListItems [Item [Plain "A", Plain "B"] Nothing, Item [Plain "C"] Nothing])++ , testCase "Table - One Row"+ $ testPretty table "Table" "| A | B | C |"+ $ Table [Row [Column [Plain "A"], Column [Plain "B"], Column [Plain "C"]]]++ , testCase "Table - One Row and Break"+ $ testPretty table "Table" "| A | B | C |\n|---+---+---|"+ $ Table [ Row [Column [Plain "A"], Column [Plain "B"], Column [Plain "C"]]+ , Break ]+ , testCase "Table - Row, Break, Row"+ $ testPretty table "Table" "| A | B | C |\n|---+---+---|\n| D | E | F |"+ $ Table [ Row [Column [Plain "A"], Column [Plain "B"], Column [Plain "C"]]+ , Break+ , Row [Column [Plain "D"], Column [Plain "E"], Column [Plain "F"]]]+ , testCase "Table - Markup"+ $ testPretty table "Table" "| *A* Yes | /B/ No |"+ $ Table [Row [Column [Bold "A", Plain "Yes"], Column [Italic "B", Plain "No"]]]+ , testCase "Table - Empty Column"+ $ testPretty table "Table" "| A | | C |"+ $ Table [Row [Column [Plain "A"], Empty, Column [Plain "C"]]]+ , testCase "Meta - Title"+ $ testPretty meta "Meta" "#+TITLE: Test"+ $ Meta (Just "Test") Nothing Nothing Nothing Nothing+ , testCase "Meta - Full"+ $ testPretty meta "Meta" "#+TITLE: Test\n#+DATE: 2020-02-17\n#+AUTHOR: Colin"+ $ Meta (Just "Test") (Just $ fromGregorian 2020 2 17) (Just "Colin") Nothing Nothing+ ]+ , testGroup "Pretty Printing"+ [ testCase "Punctuation" $ do+ let !orig = parseMaybe orgP "A /B/. C?"+ (prettyOrg <$> orig) @?= Just "A /B/. C?"+ ]+ , testGroup "Full Files"+ [ testCase "Simple" $ case parse orgFile "simple.org" simple of+ Left eb -> assertFailure $ errorBundlePretty eb+ Right r -> case parse orgFile "simple.org - reparse" (prettyOrgFile r) of+ Left eb' -> assertFailure $ errorBundlePretty eb'+ Right r' -> r' @?= r+ , testCase "Full" $ case parse orgFile "test.org" full of+ Left eb -> assertFailure $ errorBundlePretty eb+ Right r -> case parse orgFile "test.org - reparse" (prettyOrgFile r) of+ Left eb' -> assertFailure $ errorBundlePretty eb'+ Right r' -> r' @?= r+ ]+ , testGroup "Megaparsec Sanity"+ [ testCase "sepEndBy1" $ testPretty sepTest "sepBy1" "A.A.A.B" ['A', 'A', 'A']+ ]+ ]++testPretty :: (Eq a, Show a) => Parsec Void Text a -> String -> Text -> a -> Assertion+testPretty parser labl src expt = case parse parser labl src of+ Left eb -> assertFailure $ errorBundlePretty eb+ Right r -> r @?= expt++-- | Conclusion: If the separator appears but the next parse attempt fails, the+-- /whole/ thing fails.+sepTest :: Parsec Void Text String+sepTest = char 'A' `sepEndBy1` char '.'