{-# 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
  , 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.Bool (bool)
import           Data.Functor (($>))
import           Data.Hashable (Hashable(..))
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map.Strict as M
import           Data.Semigroup (sconcat)
import           Data.Text (Text)
import qualified Data.Text as T
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

--------------------------------------------------------------------------------
-- Types

-- | A complete @.org@ file with metadata.
data OrgFile = OrgFile
  { OrgFile -> Map Text Text
orgMeta :: M.Map Text Text
  -- ^ Top-level fields like:
  --
  -- @
  -- #+TITLE: Curing Cancer with Haskell
  -- #+DATE: 2020-02-25
  -- #+AUTHOR: Colin
  -- @
  , OrgFile -> OrgDoc
orgDoc  :: OrgDoc }
  deriving stock (OrgFile -> OrgFile -> Bool
(OrgFile -> OrgFile -> Bool)
-> (OrgFile -> OrgFile -> Bool) -> Eq OrgFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgFile -> OrgFile -> Bool
$c/= :: OrgFile -> OrgFile -> Bool
== :: OrgFile -> OrgFile -> Bool
$c== :: OrgFile -> OrgFile -> Bool
Eq, Int -> OrgFile -> ShowS
[OrgFile] -> ShowS
OrgFile -> String
(Int -> OrgFile -> ShowS)
-> (OrgFile -> String) -> ([OrgFile] -> ShowS) -> Show OrgFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgFile] -> ShowS
$cshowList :: [OrgFile] -> ShowS
show :: OrgFile -> String
$cshow :: OrgFile -> String
showsPrec :: Int -> OrgFile -> ShowS
$cshowsPrec :: Int -> OrgFile -> ShowS
Show, (forall x. OrgFile -> Rep OrgFile x)
-> (forall x. Rep OrgFile x -> OrgFile) -> Generic OrgFile
forall x. Rep OrgFile x -> OrgFile
forall x. OrgFile -> Rep OrgFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgFile x -> OrgFile
$cfrom :: forall x. OrgFile -> Rep OrgFile x
Generic)

emptyOrgFile :: OrgFile
emptyOrgFile :: OrgFile
emptyOrgFile = Map Text Text -> OrgDoc -> OrgFile
OrgFile Map Text Text
forall a. Monoid a => a
mempty OrgDoc
emptyDoc

-- | 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
  { OrgDoc -> [Block]
docBlocks   :: [Block]
  , OrgDoc -> [Section]
docSections :: [Section] }
  deriving stock (OrgDoc -> OrgDoc -> Bool
(OrgDoc -> OrgDoc -> Bool)
-> (OrgDoc -> OrgDoc -> Bool) -> Eq OrgDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgDoc -> OrgDoc -> Bool
$c/= :: OrgDoc -> OrgDoc -> Bool
== :: OrgDoc -> OrgDoc -> Bool
$c== :: OrgDoc -> OrgDoc -> Bool
Eq, Int -> OrgDoc -> ShowS
[OrgDoc] -> ShowS
OrgDoc -> String
(Int -> OrgDoc -> ShowS)
-> (OrgDoc -> String) -> ([OrgDoc] -> ShowS) -> Show OrgDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgDoc] -> ShowS
$cshowList :: [OrgDoc] -> ShowS
show :: OrgDoc -> String
$cshow :: OrgDoc -> String
showsPrec :: Int -> OrgDoc -> ShowS
$cshowsPrec :: Int -> OrgDoc -> ShowS
Show, (forall x. OrgDoc -> Rep OrgDoc x)
-> (forall x. Rep OrgDoc x -> OrgDoc) -> Generic OrgDoc
forall x. Rep OrgDoc x -> OrgDoc
forall x. OrgDoc -> Rep OrgDoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgDoc x -> OrgDoc
$cfrom :: forall x. OrgDoc -> Rep OrgDoc x
Generic)
  deriving anyclass (Int -> OrgDoc -> Int
OrgDoc -> Int
(Int -> OrgDoc -> Int) -> (OrgDoc -> Int) -> Hashable OrgDoc
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OrgDoc -> Int
$chash :: OrgDoc -> Int
hashWithSalt :: Int -> OrgDoc -> Int
$chashWithSalt :: Int -> OrgDoc -> Int
Hashable)

emptyDoc :: OrgDoc
emptyDoc :: OrgDoc
emptyDoc = [Block] -> [Section] -> OrgDoc
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 (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, (forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic)
  deriving anyclass (Int -> Block -> Int
Block -> Int
(Int -> Block -> Int) -> (Block -> Int) -> Hashable Block
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Block -> Int
$chash :: Block -> Int
hashWithSalt :: Int -> Block -> Int
$chashWithSalt :: Int -> Block -> Int
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
  { Section -> NonEmpty Words
sectionHeading :: NonEmpty Words
  , Section -> [Text]
sectionTags    :: [Text]
  , Section -> OrgDoc
sectionDoc     :: OrgDoc }
  deriving stock (Section -> Section -> Bool
(Section -> Section -> Bool)
-> (Section -> Section -> Bool) -> Eq Section
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section -> Section -> Bool
$c/= :: Section -> Section -> Bool
== :: Section -> Section -> Bool
$c== :: Section -> Section -> Bool
Eq, Int -> Section -> ShowS
[Section] -> ShowS
Section -> String
(Int -> Section -> ShowS)
-> (Section -> String) -> ([Section] -> ShowS) -> Show Section
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section] -> ShowS
$cshowList :: [Section] -> ShowS
show :: Section -> String
$cshow :: Section -> String
showsPrec :: Int -> Section -> ShowS
$cshowsPrec :: Int -> Section -> ShowS
Show, (forall x. Section -> Rep Section x)
-> (forall x. Rep Section x -> Section) -> Generic Section
forall x. Rep Section x -> Section
forall x. Section -> Rep Section x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Section x -> Section
$cfrom :: forall x. Section -> Rep Section x
Generic)
  deriving anyclass (Int -> Section -> Int
Section -> Int
(Int -> Section -> Int) -> (Section -> Int) -> Hashable Section
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Section -> Int
$chash :: Section -> Int
hashWithSalt :: Int -> Section -> Int
$chashWithSalt :: Int -> Section -> Int
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 (ListItems -> ListItems -> Bool
(ListItems -> ListItems -> Bool)
-> (ListItems -> ListItems -> Bool) -> Eq ListItems
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListItems -> ListItems -> Bool
$c/= :: ListItems -> ListItems -> Bool
== :: ListItems -> ListItems -> Bool
$c== :: ListItems -> ListItems -> Bool
Eq, Int -> ListItems -> ShowS
[ListItems] -> ShowS
ListItems -> String
(Int -> ListItems -> ShowS)
-> (ListItems -> String)
-> ([ListItems] -> ShowS)
-> Show ListItems
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListItems] -> ShowS
$cshowList :: [ListItems] -> ShowS
show :: ListItems -> String
$cshow :: ListItems -> String
showsPrec :: Int -> ListItems -> ShowS
$cshowsPrec :: Int -> ListItems -> ShowS
Show, (forall x. ListItems -> Rep ListItems x)
-> (forall x. Rep ListItems x -> ListItems) -> Generic ListItems
forall x. Rep ListItems x -> ListItems
forall x. ListItems -> Rep ListItems x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListItems x -> ListItems
$cfrom :: forall x. ListItems -> Rep ListItems x
Generic)
  deriving anyclass (Int -> ListItems -> Int
ListItems -> Int
(Int -> ListItems -> Int)
-> (ListItems -> Int) -> Hashable ListItems
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ListItems -> Int
$chash :: ListItems -> Int
hashWithSalt :: Int -> ListItems -> Int
$chashWithSalt :: Int -> ListItems -> Int
Hashable)

-- | A line in a bullet-list. Can contain sublists, as shown in `ListItems`.
data Item = Item (NonEmpty Words) (Maybe ListItems)
  deriving stock (Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq, Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show, (forall x. Item -> Rep Item x)
-> (forall x. Rep Item x -> Item) -> Generic Item
forall x. Rep Item x -> Item
forall x. Item -> Rep Item x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Item x -> Item
$cfrom :: forall x. Item -> Rep Item x
Generic)
  deriving anyclass (Int -> Item -> Int
Item -> Int
(Int -> Item -> Int) -> (Item -> Int) -> Hashable Item
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Item -> Int
$chash :: Item -> Int
hashWithSalt :: Int -> Item -> Int
$chashWithSalt :: Int -> Item -> Int
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 (Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
(Int -> Row -> ShowS)
-> (Row -> String) -> ([Row] -> ShowS) -> Show Row
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show, (forall x. Row -> Rep Row x)
-> (forall x. Rep Row x -> Row) -> Generic Row
forall x. Rep Row x -> Row
forall x. Row -> Rep Row x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Row x -> Row
$cfrom :: forall x. Row -> Rep Row x
Generic)
  deriving anyclass (Int -> Row -> Int
Row -> Int
(Int -> Row -> Int) -> (Row -> Int) -> Hashable Row
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Row -> Int
$chash :: Row -> Int
hashWithSalt :: Int -> Row -> Int
$chashWithSalt :: Int -> Row -> Int
Hashable)

-- | A possibly empty column in an org table.
data Column = Empty | Column (NonEmpty Words)
  deriving stock (Column -> Column -> Bool
(Column -> Column -> Bool)
-> (Column -> Column -> Bool) -> Eq Column
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Column -> Column -> Bool
$c/= :: Column -> Column -> Bool
== :: Column -> Column -> Bool
$c== :: Column -> Column -> Bool
Eq, Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
(Int -> Column -> ShowS)
-> (Column -> String) -> ([Column] -> ShowS) -> Show Column
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show, (forall x. Column -> Rep Column x)
-> (forall x. Rep Column x -> Column) -> Generic Column
forall x. Rep Column x -> Column
forall x. Column -> Rep Column x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Column x -> Column
$cfrom :: forall x. Column -> Rep Column x
Generic)
  deriving anyclass (Int -> Column -> Int
Column -> Int
(Int -> Column -> Int) -> (Column -> Int) -> Hashable Column
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Column -> Int
$chash :: Column -> Int
hashWithSalt :: Int -> Column -> Int
$chashWithSalt :: Int -> Column -> Int
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
  | Tags (NonEmpty Text)
  | Punct Char
  | Plain Text
  deriving stock (Words -> Words -> Bool
(Words -> Words -> Bool) -> (Words -> Words -> Bool) -> Eq Words
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Words -> Words -> Bool
$c/= :: Words -> Words -> Bool
== :: Words -> Words -> Bool
$c== :: Words -> Words -> Bool
Eq, Int -> Words -> ShowS
[Words] -> ShowS
Words -> String
(Int -> Words -> ShowS)
-> (Words -> String) -> ([Words] -> ShowS) -> Show Words
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Words] -> ShowS
$cshowList :: [Words] -> ShowS
show :: Words -> String
$cshow :: Words -> String
showsPrec :: Int -> Words -> ShowS
$cshowsPrec :: Int -> Words -> ShowS
Show, (forall x. Words -> Rep Words x)
-> (forall x. Rep Words x -> Words) -> Generic Words
forall x. Rep Words x -> Words
forall x. Words -> Rep Words x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Words x -> Words
$cfrom :: forall x. Words -> Rep Words x
Generic)
  deriving anyclass (Int -> Words -> Int
Words -> Int
(Int -> Words -> Int) -> (Words -> Int) -> Hashable Words
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Words -> Int
$chash :: Words -> Int
hashWithSalt :: Int -> Words -> Int
$chashWithSalt :: Int -> Words -> Int
Hashable)

-- | The url portion of a link.
newtype URL = URL Text
  deriving stock (URL -> URL -> Bool
(URL -> URL -> Bool) -> (URL -> URL -> Bool) -> Eq URL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c== :: URL -> URL -> Bool
Eq, Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
(Int -> URL -> ShowS)
-> (URL -> String) -> ([URL] -> ShowS) -> Show URL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> String
$cshow :: URL -> String
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show, (forall x. URL -> Rep URL x)
-> (forall x. Rep URL x -> URL) -> Generic URL
forall x. Rep URL x -> URL
forall x. URL -> Rep URL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URL x -> URL
$cfrom :: forall x. URL -> Rep URL x
Generic)
  deriving anyclass (Int -> URL -> Int
URL -> Int
(Int -> URL -> Int) -> (URL -> Int) -> Hashable URL
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: URL -> Int
$chash :: URL -> Int
hashWithSalt :: Int -> URL -> Int
$chashWithSalt :: Int -> URL -> Int
Hashable)

-- | The programming language some source code block was written in.
newtype Language = Language Text
  deriving stock (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show, (forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Language x -> Language
$cfrom :: forall x. Language -> Rep Language x
Generic)
  deriving anyclass (Int -> Language -> Int
Language -> Int
(Int -> Language -> Int) -> (Language -> Int) -> Hashable Language
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Language -> Int
$chash :: Language -> Int
hashWithSalt :: Int -> Language -> Int
$chashWithSalt :: Int -> Language -> Int
Hashable)

--------------------------------------------------------------------------------
-- Parser

-- | Attempt to parse an `OrgFile`.
org :: Text -> Maybe OrgFile
org :: Text -> Maybe OrgFile
org = Parsec Void Text OrgFile -> Text -> Maybe OrgFile
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text OrgFile
orgFile

type Parser = Parsec Void Text

orgFile :: Parser OrgFile
orgFile :: Parsec Void Text OrgFile
orgFile = ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity ()
-> Parsec Void Text OrgFile -> Parsec Void Text OrgFile
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
-> Parsec Void Text OrgFile -> Parsec Void Text OrgFile
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (Map Text Text -> OrgDoc -> OrgFile
OrgFile (Map Text Text -> OrgDoc -> OrgFile)
-> ParsecT Void Text Identity (Map Text Text)
-> ParsecT Void Text Identity (OrgDoc -> OrgFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Map Text Text)
meta ParsecT Void Text Identity (OrgDoc -> OrgFile)
-> ParsecT Void Text Identity OrgDoc -> Parsec Void Text OrgFile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity OrgDoc
orgP) Parsec Void Text OrgFile
-> ParsecT Void Text Identity () -> Parsec Void Text OrgFile
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

meta :: Parser (M.Map Text Text)
meta :: ParsecT Void Text Identity (Map Text Text)
meta = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Map Text Text)
-> ParsecT Void Text Identity (Map Text Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity (Map Text Text)
 -> ParsecT Void Text Identity (Map Text Text))
-> ParsecT Void Text Identity (Map Text Text)
-> ParsecT Void Text Identity (Map Text Text)
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Text)] -> Map Text Text)
-> ParsecT Void Text Identity [(Text, Text)]
-> ParsecT Void Text Identity (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, Text)
keyword Parser (Text, Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [(Text, Text)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  where
    keyword :: Parser (Text, Text)
    keyword :: Parser (Text, Text)
keyword = do
      ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+"
      Text
key <- Char -> ParsecT Void Text Identity Text
someTill' Char
':'
      ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
": "
      Text
val <- ParsecT Void Text Identity Text
someTillEnd
      (Text, Text) -> Parser (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Text
val)

orgP :: Parser OrgDoc
orgP :: ParsecT Void Text Identity OrgDoc
orgP = Int -> ParsecT Void Text Identity OrgDoc
orgP' Int
1

orgP' :: Int -> Parser OrgDoc
orgP' :: Int -> ParsecT Void Text Identity OrgDoc
orgP' Int
depth = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity OrgDoc
-> ParsecT Void Text Identity OrgDoc
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity OrgDoc
 -> ParsecT Void Text Identity OrgDoc)
-> ParsecT Void Text Identity OrgDoc
-> ParsecT Void Text Identity OrgDoc
forall a b. (a -> b) -> a -> b
$ [Block] -> [Section] -> OrgDoc
OrgDoc
  ([Block] -> [Section] -> OrgDoc)
-> ParsecT Void Text Identity [Block]
-> ParsecT Void Text Identity ([Section] -> OrgDoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity [Block]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Block
block
  ParsecT Void Text Identity ([Section] -> OrgDoc)
-> ParsecT Void Text Identity [Section]
-> ParsecT Void Text Identity OrgDoc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Section
-> ParsecT Void Text Identity [Section]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Section
-> ParsecT Void Text Identity Section
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Section
 -> ParsecT Void Text Identity Section)
-> ParsecT Void Text Identity Section
-> ParsecT Void Text Identity Section
forall a b. (a -> b) -> a -> b
$ Int -> ParsecT Void Text Identity Section
section Int
depth)
  where
    block :: Parser Block
    block :: ParsecT Void Text Identity Block
block = [ParsecT Void Text Identity Block]
-> ParsecT Void Text Identity Block
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
code
      , ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
example
      , ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
quote
      , ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
list
      , ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
table
      , ParsecT Void Text Identity Block
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, [Text])
heading :: Parser (Text, NonEmpty Words, [Text])
heading = do
  Text
stars <- Char -> ParsecT Void Text Identity Text
someOf Char
'*' ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' '
  NonEmpty Words
ws <- Char -> Parser (NonEmpty Words)
line Char
'\n'
  case NonEmpty Words -> (Words, Maybe (NonEmpty Words))
forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
nelUnsnoc NonEmpty Words
ws of
    (Tags NonEmpty Text
ts, Just NonEmpty Words
rest) -> (Text, NonEmpty Words, [Text])
-> Parser (Text, NonEmpty Words, [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
stars, NonEmpty Words
rest, NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Text
ts)
    (Words, Maybe (NonEmpty Words))
_                    -> (Text, NonEmpty Words, [Text])
-> Parser (Text, NonEmpty Words, [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
stars, NonEmpty Words
ws, [])

section :: Int -> Parser Section
section :: Int -> ParsecT Void Text Identity Section
section Int
depth = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Section
-> ParsecT Void Text Identity Section
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Section
 -> ParsecT Void Text Identity Section)
-> ParsecT Void Text Identity Section
-> ParsecT Void Text Identity Section
forall a b. (a -> b) -> a -> b
$ do
  (Text
stars, NonEmpty Words
ws, [Text]
ts) <- Parser (Text, NonEmpty Words, [Text])
heading
  -- Fail if we've found a parent heading --
  Bool
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Int
T.length Text
stars Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
depth) (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (ErrorItem (Token Text))
-> Set (ErrorItem (Token Text)) -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure Maybe (ErrorItem (Token Text))
forall a. Maybe a
Nothing Set (ErrorItem (Token Text))
forall a. Monoid a => a
mempty
  -- Otherwise continue --
  ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  NonEmpty Words -> [Text] -> OrgDoc -> Section
Section NonEmpty Words
ws [Text]
ts (OrgDoc -> Section)
-> ParsecT Void Text Identity OrgDoc
-> ParsecT Void Text Identity Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void Text Identity OrgDoc
orgP' (Int -> Int
forall a. Enum a => a -> a
succ Int
depth)

quote :: Parser Block
quote :: ParsecT Void Text Identity Block
quote = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Block
 -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
top ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [Text]
ls <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (ParsecT Void Text Identity Text
manyTillEnd ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) ParsecT Void Text Identity (Tokens Text)
bot
  Block -> ParsecT Void Text Identity Block
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> (Text -> Block) -> Text -> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Block
Quote (Text -> ParsecT Void Text Identity Block)
-> Text -> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls
  where
    top :: ParsecT Void Text Identity (Tokens Text)
top = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"BEGIN_QUOTE" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"begin_quote")
    bot :: ParsecT Void Text Identity (Tokens Text)
bot = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"END_QUOTE" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end_quote")

example :: Parser Block
example :: ParsecT Void Text Identity Block
example = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Block
 -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
top ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [Text]
ls <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (ParsecT Void Text Identity Text
manyTillEnd ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) ParsecT Void Text Identity (Tokens Text)
bot
  Block -> ParsecT Void Text Identity Block
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> (Text -> Block) -> Text -> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Block
Example (Text -> ParsecT Void Text Identity Block)
-> Text -> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls
  where
    top :: ParsecT Void Text Identity (Tokens Text)
top = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"BEGIN_EXAMPLE" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"begin_example")
    bot :: ParsecT Void Text Identity (Tokens Text)
bot = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"END_EXAMPLE" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end_example")

code :: Parser Block
code :: ParsecT Void Text Identity Block
code = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Block
 -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ do
  Maybe Text
lang <- ParsecT Void Text Identity (Tokens Text)
top ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
lng ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [Text]
ls <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (ParsecT Void Text Identity Text
manyTillEnd ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) ParsecT Void Text Identity (Tokens Text)
bot
  Block -> ParsecT Void Text Identity Block
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ParsecT Void Text Identity Block)
-> (Text -> Block) -> Text -> ParsecT Void Text Identity Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Language -> Text -> Block
Code (Text -> Language
Language (Text -> Language) -> Maybe Text -> Maybe Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
lang) (Text -> ParsecT Void Text Identity Block)
-> Text -> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls
  where
    top :: ParsecT Void Text Identity (Tokens Text)
top = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"BEGIN_SRC" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"begin_src")
    bot :: ParsecT Void Text Identity (Tokens Text)
bot = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"END_SRC" ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end_src")
    lng :: ParsecT Void Text Identity Text
lng = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' '  ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
someTillEnd

list :: Parser Block
list :: ParsecT Void Text Identity Block
list = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Block
 -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ ListItems -> Block
List (ListItems -> Block)
-> ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void Text Identity ListItems
listItems Int
0

listItems :: Int -> Parser ListItems
listItems :: Int -> ParsecT Void Text Identity ListItems
listItems Int
indent = NonEmpty Item -> ListItems
ListItems
  (NonEmpty Item -> ListItems)
-> ParsecT Void Text Identity (NonEmpty Item)
-> ParsecT Void Text Identity ListItems
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Item
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (NonEmpty Item)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepBy1 (Int -> ParsecT Void Text Identity Item
item Int
indent) (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Int -> ParsecT Void Text Identity ()
nextItem Int
indent))

nextItem :: Int -> Parser ()
nextItem :: Int -> ParsecT Void Text Identity ()
nextItem Int
indent = do
  ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ParsecT Void Text Identity ())
-> Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
indent Text
" "
  ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"- "

-- | 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 :: Int -> ParsecT Void Text Identity Item
item Int
indent = do
  Text
leading <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT Void Text Identity (Tokens Text))
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
indent Text
" "
  ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"- "
  NonEmpty Words
l <- Parser (NonEmpty Words)
bullet
  let !nextInd :: Int
nextInd = Text -> Int
T.length Text
leading Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
  NonEmpty Words -> Maybe ListItems -> Item
Item NonEmpty Words
l (Maybe ListItems -> Item)
-> ParsecT Void Text Identity (Maybe ListItems)
-> ParsecT Void Text Identity Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity (Maybe ListItems)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity ListItems
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity ListItems
 -> ParsecT Void Text Identity ListItems)
-> ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity ListItems
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity ListItems
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT Void Text Identity ListItems
listItems Int
nextInd)
  where
    bullet :: Parser (NonEmpty Words)
    bullet :: Parser (NonEmpty Words)
bullet = do
      NonEmpty Words
l <- Char -> Parser (NonEmpty Words)
line Char
'\n'
      Parser (NonEmpty Words) -> Parser (NonEmpty Words)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void Text Identity ()
keepGoing ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity ()
-> Parser (NonEmpty Words) -> Parser (NonEmpty Words)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((NonEmpty Words
l NonEmpty Words -> NonEmpty Words -> NonEmpty Words
forall a. Semigroup a => a -> a -> a
<>) (NonEmpty Words -> NonEmpty Words)
-> Parser (NonEmpty Words) -> Parser (NonEmpty Words)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (NonEmpty Words)
bullet)) Parser (NonEmpty Words)
-> Parser (NonEmpty Words) -> Parser (NonEmpty Words)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NonEmpty Words -> Parser (NonEmpty Words)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty Words
l

    keepGoing :: Parser ()
    keepGoing :: ParsecT Void Text Identity ()
keepGoing = ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\n' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void Text Identity Text
manyOf Char
' ' ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'-', Char
'\n']

table :: Parser Block
table :: ParsecT Void Text Identity Block
table = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Block
 -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ NonEmpty Row -> Block
Table (NonEmpty Row -> Block)
-> ParsecT Void Text Identity (NonEmpty Row)
-> ParsecT Void Text Identity Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Row
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (NonEmpty Row)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 ParsecT Void Text Identity Row
row (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\n')
  where
    row :: Parser Row
    row :: ParsecT Void Text Identity Row
row = do
      ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'|'
      ParsecT Void Text Identity Row
brk ParsecT Void Text Identity Row
-> ParsecT Void Text Identity Row -> ParsecT Void Text Identity Row
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NonEmpty Column -> Row
Row (NonEmpty Column -> Row)
-> ParsecT Void Text Identity (NonEmpty Column)
-> ParsecT Void Text Identity Row
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Column
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (NonEmpty Column)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 ParsecT Void Text Identity Column
column (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'|'))

    -- | If the line starts with @|-@, assume its a break regardless of what
    -- chars come after that.
    brk :: Parser Row
    brk :: ParsecT Void Text Identity Row
brk = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
manyTillEnd ParsecT Void Text Identity Text
-> Row -> ParsecT Void Text Identity Row
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Row
Break

    column :: Parser Column
    column :: ParsecT Void Text Identity Column
column = do
      ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Void Text Identity Text
someOf Char
' '
      (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'|') ParsecT Void Text Identity Char
-> Column -> ParsecT Void Text Identity Column
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Column
Empty) ParsecT Void Text Identity Column
-> ParsecT Void Text Identity Column
-> ParsecT Void Text Identity Column
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NonEmpty Words -> Column
Column (NonEmpty Words -> Column)
-> Parser (NonEmpty Words) -> ParsecT Void Text Identity Column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser (NonEmpty Words)
line Char
'|')

paragraph :: Parser Block
paragraph :: ParsecT Void Text Identity Block
paragraph = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Block
 -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ do
  Parser (Text, NonEmpty Words, [Text])
-> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser (Text, NonEmpty Words, [Text])
heading
  NonEmpty Words -> Block
Paragraph (NonEmpty Words -> Block)
-> (NonEmpty (NonEmpty Words) -> NonEmpty Words)
-> NonEmpty (NonEmpty Words)
-> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (NonEmpty Words) -> NonEmpty Words
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (NonEmpty Words) -> Block)
-> ParsecT Void Text Identity (NonEmpty (NonEmpty Words))
-> ParsecT Void Text Identity Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (NonEmpty Words)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (NonEmpty (NonEmpty Words))
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 (Char -> Parser (NonEmpty Words)
line Char
'\n') ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

line :: Char -> Parser (NonEmpty Words)
line :: Char -> Parser (NonEmpty Words)
line Char
end = ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Text -> Parser (NonEmpty Words)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 (Char -> ParsecT Void Text Identity Words
wordChunk Char
end) (Char -> ParsecT Void Text Identity Text
manyOf Char
' ')

-- | 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 :: Char -> ParsecT Void Text Identity Words
wordChunk Char
end = [ParsecT Void Text Identity Words]
-> ParsecT Void Text Identity Words
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Bold      (Text -> Words)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*') (Char -> ParsecT Void Text Identity Text
someTill' Char
'*') ParsecT Void Text Identity Words
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Italic    (Text -> Words)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/') (Char -> ParsecT Void Text Identity Text
someTill' Char
'/') ParsecT Void Text Identity Words
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Highlight (Text -> Words)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'~') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'~') (Char -> ParsecT Void Text Identity Text
someTill' Char
'~') ParsecT Void Text Identity Words
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Verbatim  (Text -> Words)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'=') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'=') (Char -> ParsecT Void Text Identity Text
someTill' Char
'=') ParsecT Void Text Identity Words
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Underline (Text -> Words)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_') (Char -> ParsecT Void Text Identity Text
someTill' Char
'_') ParsecT Void Text Identity Words
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Strike    (Text -> Words)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+') (Char -> ParsecT Void Text Identity Text
someTill' Char
'+') ParsecT Void Text Identity Words
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Words
image
  , ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Words
link
  , ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Words
tags
  , ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ Char -> Words
Punct     (Char -> Words)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token Text]
punc
  , Text -> Words
Plain           (Text -> Words)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"plain text") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
end) ]
  where
    pOrS :: Parser ()
    pOrS :: ParsecT Void Text Identity ()
pOrS = ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf ([Token Text] -> ParsecT Void Text Identity (Token Text))
-> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ Char
end Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
punc) ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

punc :: String
punc :: String
punc = String
".,!?():;'"

tags :: Parser Words
tags :: ParsecT Void Text Identity Words
tags = do
  ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
  NonEmpty Text -> Words
Tags (NonEmpty Text -> Words)
-> ParsecT Void Text Identity (NonEmpty Text)
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack (String -> Text)
-> (NonEmpty Char -> String) -> NonEmpty Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NEL.toList (NonEmpty Char -> Text)
-> ParsecT Void Text Identity (NonEmpty Char)
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (NonEmpty Char)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
some ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar) ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (NonEmpty Text)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`sepEndBy1` Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'

image :: Parser Words
image :: ParsecT Void Text Identity Words
image = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']') (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$
  ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']') (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ do
    Text
path <- Char -> ParsecT Void Text Identity Text
someTill' Char
']'
    let !ext :: String
ext = ShowS
takeExtension ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
path
    Bool
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
ext String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".jpg", String
".jpeg", String
".png"]) (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (ErrorItem (Token Text))
-> Set (ErrorItem (Token Text)) -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure Maybe (ErrorItem (Token Text))
forall a. Maybe a
Nothing Set (ErrorItem (Token Text))
forall a. Monoid a => a
mempty
    Words -> ParsecT Void Text Identity Words
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Words -> ParsecT Void Text Identity Words)
-> (URL -> Words) -> URL -> ParsecT Void Text Identity Words
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URL -> Words
Image (URL -> ParsecT Void Text Identity Words)
-> URL -> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ Text -> URL
URL Text
path

link :: Parser Words
link :: ParsecT Void Text Identity Words
link = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']') (ParsecT Void Text Identity Words
 -> ParsecT Void Text Identity Words)
-> ParsecT Void Text Identity Words
-> ParsecT Void Text Identity Words
forall a b. (a -> b) -> a -> b
$ URL -> Maybe Text -> Words
Link
  (URL -> Maybe Text -> Words)
-> ParsecT Void Text Identity URL
-> ParsecT Void Text Identity (Maybe Text -> Words)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity URL
-> ParsecT Void Text Identity URL
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']') (Text -> URL
URL (Text -> URL)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity URL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Void Text Identity Text
someTill' Char
']')
  ParsecT Void Text Identity (Maybe Text -> Words)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity Words
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']') (Char -> ParsecT Void Text Identity Text
someTill' Char
']'))

someTillEnd :: Parser Text
someTillEnd :: ParsecT Void Text Identity Text
someTillEnd = Char -> ParsecT Void Text Identity Text
someTill' Char
'\n'

manyTillEnd :: Parser Text
manyTillEnd :: ParsecT Void Text Identity Text
manyTillEnd = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"many until the end of the line") (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')

someTill' :: Char -> Parser Text
someTill' :: Char -> ParsecT Void Text Identity Text
someTill' Char
c = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"some until " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
c]) (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c)

-- | Fast version of `some` specialized to `Text`.
someOf :: Char -> Parser Text
someOf :: Char -> ParsecT Void Text Identity Text
someOf Char
c = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"some of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
c]) (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)

manyOf :: Char -> Parser Text
manyOf :: Char -> ParsecT Void Text Identity Text
manyOf Char
c = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"many of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
c]) (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)

--------------------------------------------------------------------------------
-- Pretty Printing

prettyOrgFile :: OrgFile -> Text
prettyOrgFile :: OrgFile -> Text
prettyOrgFile (OrgFile Map Text Text
m OrgDoc
os) = Text
metas Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OrgDoc -> Text
prettyOrg OrgDoc
os
  where
    metas :: Text
metas = Text -> [Text] -> Text
T.intercalate Text
"\n"
      ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
l, Text
t) -> Text
"#+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
      ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Text
m

prettyOrg :: OrgDoc -> Text
prettyOrg :: OrgDoc -> Text
prettyOrg  = Int -> OrgDoc -> Text
prettyOrg' Int
1

prettyOrg' :: Int -> OrgDoc -> Text
prettyOrg' :: Int -> OrgDoc -> Text
prettyOrg' Int
depth (OrgDoc [Block]
bs [Section]
ss) =
  Text -> [Text] -> Text
T.intercalate Text
"\n\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Block -> Text) -> [Block] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Text
prettyBlock [Block]
bs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Section -> Text) -> [Section] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Section -> Text
prettySection Int
depth) [Section]
ss

prettySection :: Int -> Section -> Text
prettySection :: Int -> Section -> Text
prettySection Int
depth (Section NonEmpty Words
ws [Text]
ts OrgDoc
od) = Text
headig Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
subdoc
  where
    -- TODO There is likely a punctuation bug here.
    headig :: Text
headig = [Text] -> Text
T.unwords
      ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
depth Text
"*"
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NEL.toList ((Words -> Text) -> NonEmpty Words -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map Words -> Text
prettyWords NonEmpty Words
ws)
      [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool [Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
":" [Text]
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"] [] ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ts)

    subdoc :: Text
    subdoc :: Text
subdoc = Int -> OrgDoc -> Text
prettyOrg' (Int -> Int
forall a. Enum a => a -> a
succ Int
depth) OrgDoc
od

prettyBlock :: Block -> Text
prettyBlock :: Block -> Text
prettyBlock Block
o = case Block
o of
  Code Maybe Language
l Text
t -> Text
"#+begin_src" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Language -> Text) -> Maybe Language -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(Language Text
l') -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") Maybe Language
l
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n#+end_src"
  Quote Text
t -> Text
"#+begin_quote\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n#+end_quote"
  Example Text
t -> Text
"#+begin_example\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n#+end_example"
  Paragraph NonEmpty Words
ht -> NonEmpty Words -> Text
par NonEmpty Words
ht
  List ListItems
items -> Int -> ListItems -> Text
lis Int
0 ListItems
items
  Table NonEmpty Row
rows -> Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Row] -> [Text]) -> [Row] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row -> Text) -> [Row] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Row -> Text
row ([Row] -> Text) -> [Row] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Row -> [Row]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Row
rows
  where
    lis :: Int -> ListItems -> Text
    lis :: Int -> ListItems -> Text
lis Int
indent (ListItems NonEmpty Item
is) = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Item] -> [Text]) -> [Item] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Item -> Text) -> [Item] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Item -> Text
f Int
indent) ([Item] -> Text) -> [Item] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Item -> [Item]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Item
is

    f :: Int -> Item -> Text
    f :: Int -> Item -> Text
f Int
indent (Item NonEmpty Words
ws Maybe ListItems
li) =
      Int -> Text -> Text
T.replicate Int
indent Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Words -> Text
par NonEmpty Words
ws
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (ListItems -> Text) -> Maybe ListItems -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\ListItems
is -> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> ListItems -> Text
lis (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ListItems
is) Maybe ListItems
li

    par :: NonEmpty Words -> Text
    par :: NonEmpty Words -> Text
par (Words
h :| [Words]
t) = Words -> Text
prettyWords Words
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
h [Words]
t

    -- | Stick punctuation directly behind the chars in front of it, while
    -- paying special attention to parentheses.
    para :: Words -> [Words] -> Text
    para :: Words -> [Words] -> Text
para Words
_ []      = Text
""
    para Words
pr (Words
w:[Words]
ws) = case Words
pr of
      Punct Char
'(' -> Words -> Text
prettyWords Words
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws
      Words
_ -> case Words
w of
        Punct Char
'(' -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> Text
prettyWords Words
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws
        Punct Char
_   -> Words -> Text
prettyWords Words
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws
        Words
_         -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> Text
prettyWords Words
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws

    row :: Row -> Text
    row :: Row -> Text
row Row
Break    = Text
"|-|"
    row (Row NonEmpty Column
cs) = Text
"| " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
" | " ([Text] -> Text) -> ([Column] -> [Text]) -> [Column] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column -> Text) -> [Column] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Column -> Text
col ([Column] -> Text) -> [Column] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Column -> [Column]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Column
cs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"

    col :: Column -> Text
    col :: Column -> Text
col Column
Empty       = Text
""
    col (Column NonEmpty Words
ws) = [Text] -> Text
T.unwords ([Text] -> Text) -> ([Words] -> [Text]) -> [Words] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Words -> Text) -> [Words] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Words -> Text
prettyWords ([Words] -> Text) -> [Words] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Words -> [Words]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Words
ws

prettyWords :: Words -> Text
prettyWords :: Words -> Text
prettyWords Words
w = case Words
w of
  Bold Text
t                  -> Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
  Italic Text
t                -> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
  Highlight Text
t             -> Text
"~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"~"
  Underline Text
t             -> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
  Verbatim Text
t              -> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"="
  Strike Text
t                -> Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+"
  Link (URL Text
url) Maybe Text
Nothing  -> Text
"[[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]]"
  Link (URL Text
url) (Just Text
t) -> Text
"[[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"][" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]]"
  Image (URL Text
url)         -> Text
"[[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]]"
  Tags NonEmpty Text
ts                 ->  Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
":" (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Text
ts) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
  Punct Char
c                 -> Char -> Text
T.singleton Char
c
  Plain Text
t                 -> Text
t

nelUnsnoc :: NonEmpty a -> (a, Maybe (NonEmpty a))
nelUnsnoc :: NonEmpty a -> (a, Maybe (NonEmpty a))
nelUnsnoc NonEmpty a
ne = (NonEmpty a -> a
forall a. NonEmpty a -> a
NEL.last NonEmpty a
ne, [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty ([a] -> Maybe (NonEmpty a)) -> [a] -> Maybe (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NEL.init NonEmpty a
ne)