diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## 0.1.0.0 - 2023-07-17 + +* First version. Released on an unsuspecting world. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# org-parser + +This library is part of a multi-package repository. Please read the README at . diff --git a/org-parser.cabal b/org-parser.cabal new file mode 100644 --- /dev/null +++ b/org-parser.cabal @@ -0,0 +1,104 @@ +cabal-version: 3.0 +name: org-parser +version: 0.1.0.0 +license: GPL-3.0-only +synopsis: Parser for Org Mode documents. +description: + org-parser provides a parser for Org Mode documents. + The Org document is parsed into an AST similar to org-element's, and + aims to be accurate and performant where possible. The types have + 'multiwalk' instances that allow traversing and querying the AST, as well + as ordering the AST semantically by its leaf text. It also features a + test suite comparing it with org-element against many corner cases. + +maintainer: @lucasvr:matrix.org +author: Lucas V. R. +bug-reports: https://github.com/lucasvreis/org-mode-hs/issues +copyright: (c) 2022 lucasvreis +category: Text +build-type: Simple +tested-with: GHC ==9.2 || ==9.4 + +-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. +extra-doc-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: git://github.com/lucasvreis/org-mode-hs.git + +common common-options + default-language: Haskell2010 + build-depends: + , aeson >=2.1.2 && <2.2 + , base >=4.15 && <4.19 + , containers >=0.6.5 && <0.7 + , megaparsec >=9.3.0 && <9.4 + , multiwalk >=0.3.0 && <0.4 + , relude >=1.2.0 && <1.3 + , replace-megaparsec >=1.4.5 && <1.5 + , text >=1.2.5 && <2.1 + , time >=1.11.1 && <1.13 + + mixins: + base hiding (Prelude), + relude (Relude as Prelude), + relude + + ghc-options: -Wall + default-extensions: + BlockArguments + ConstraintKinds + DeriveGeneric + FlexibleContexts + ImportQualifiedPost + LambdaCase + MultiWayIf + OverloadedStrings + ScopedTypeVariables + TupleSections + ViewPatterns + +library + import: common-options + hs-source-dirs: src + exposed-modules: + Org.Builder + Org.Compare + Org.Data.Entities + Org.Parser + Org.Parser.Document + Org.Parser.Elements + Org.Parser.Objects + Org.Types + Org.Walk + + other-modules: + Org.Parser.Common + Org.Parser.Definitions + Org.Parser.MarkupContexts + Org.Parser.State + +test-suite test + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: test-org-parser.hs + build-depends: + , Diff >=0.4 && <0.5 + , neat-interpolation >=0.5 && <0.6 + , org-parser + , pretty >=1.1 && <1.2 + , pretty-simple >=4.1 && <4.2 + , tasty >=1.4 && <1.5 + , tasty-hunit >=0.10 && <0.11 + + other-modules: + Tests.Document + Tests.Elements + Tests.Helpers + Tests.Objects + + ghc-options: -threaded -with-rtsopts=-N + default-extensions: QuasiQuotes diff --git a/src/Org/Builder.hs b/src/Org/Builder.hs new file mode 100644 --- /dev/null +++ b/src/Org/Builder.hs @@ -0,0 +1,273 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} + +module Org.Builder where + +import Data.Sequence (ViewL (..), ViewR (..), viewl, viewr, (|>)) +import Data.Text qualified as T +import GHC.Exts qualified +import Org.Types + +newtype Many a = Many {unMany :: Seq a} + deriving (Ord, Eq, Typeable, Foldable, Traversable, Functor, Show, Read) + +instance One (Many a) where + type OneItem (Many a) = a + one = Many . one + +instance IsList (Many a) where + type Item (Many a) = a + fromList = Many . fromList + toList = toList . unMany + +deriving instance Generic (Many a) + +type OrgObjects = Many OrgObject + +type OrgElements = Many OrgElement + +deriving instance Semigroup OrgElements + +deriving instance Monoid OrgElements + +instance Semigroup OrgObjects where + (Many xs) <> (Many ys) = + case (viewr xs, viewl ys) of + (EmptyR, _) -> Many ys + (_, EmptyL) -> Many xs + (xs' :> x, y :< ys') -> Many (meld <> ys') + where + meld = + case (x, y) of + (Plain t1, Plain t2) -> xs' |> Plain (t1 <> t2) + (Plain t1, LineBreak) -> xs' |> Plain (T.stripEnd t1) |> LineBreak + (LineBreak, Plain t2) -> xs' |> LineBreak |> Plain (T.stripStart t2) + (Italic i1, Italic i2) -> xs' |> Italic (i1 <> i2) + (Underline i1, Underline i2) -> xs' |> Underline (i1 <> i2) + (Bold i1, Bold i2) -> xs' |> Bold (i1 <> i2) + (Subscript i1, Subscript i2) -> xs' |> Subscript (i1 <> i2) + (Superscript i1, Superscript i2) -> xs' |> Superscript (i1 <> i2) + (Strikethrough i1, Strikethrough i2) -> xs' |> Strikethrough (i1 <> i2) + (Code i1, Code i2) -> xs' |> Code (i1 <> i2) + (Verbatim i1, Verbatim i2) -> xs' |> Verbatim (i1 <> i2) + _ -> xs' |> x |> y + +instance Monoid OrgObjects where + mempty = Many mempty + mappend = (<>) + +instance IsString OrgObjects where + fromString = plain . T.pack + +instance IsString OrgElements where + fromString = element . para . plain . T.pack + +-- * Element builders + +element :: OrgElementData -> OrgElements +element = one . OrgElement mempty + +element' :: [(Text, KeywordValue)] -> OrgElementData -> OrgElements +element' aff = one . OrgElement (fromList aff) + +para :: OrgObjects -> OrgElementData +para = Paragraph . toList + +export :: Text -> Text -> OrgElementData +export = ExportBlock + +example :: + Map Text Text -> + [SrcLine] -> + OrgElementData +example = ExampleBlock + +srcBlock :: + Text -> + Map Text Text -> + [(Text, Text)] -> + [SrcLine] -> + OrgElementData +srcBlock = SrcBlock + +greaterBlock :: + GreaterBlockType -> + OrgElements -> + OrgElementData +greaterBlock btype = GreaterBlock btype . toList + +drawer :: + Text -> + OrgElements -> + OrgElementData +drawer name = Drawer name . toList + +latexEnvironment :: + Text -> + Text -> + OrgElementData +latexEnvironment = LaTeXEnvironment + +listItemUnord :: Char -> OrgElements -> ListItem +listItemUnord s = ListItem (Bullet s) Nothing Nothing [] . toList + +list :: + ListType -> + [ListItem] -> + OrgElementData +list = PlainList + +orderedList :: + OrderedStyle -> + Char -> + [OrgElements] -> + OrgElementData +orderedList style separator = + PlainList (Ordered style) + . zipWith (\b -> ListItem b Nothing Nothing [] . toList) bullets + where + bullets = case style of + OrderedNum -> [Counter (show i) separator | i :: Int <- [1 ..]] + OrderedAlpha -> [Counter (one a) separator | a <- ['a' ..]] + +descriptiveList :: + [(OrgObjects, OrgElements)] -> + OrgElementData +descriptiveList = + PlainList Descriptive + . map (\(tag, els) -> ListItem (Bullet '-') Nothing Nothing (toList tag) (toList els)) + +parsedKeyword :: + OrgObjects -> + KeywordValue +parsedKeyword = ParsedKeyword . toList + +valueKeyword :: + Text -> + KeywordValue +valueKeyword = ValueKeyword + +attrKeyword :: + [(Text, Text)] -> + KeywordValue +attrKeyword = BackendKeyword + +keyword :: + Text -> + KeywordValue -> + OrgElementData +keyword = Keyword + +clock :: TimestampData -> Maybe Time -> OrgElementData +clock = Clock + +footnoteDef :: Text -> OrgElements -> OrgElementData +footnoteDef l = FootnoteDef l . toList + +horizontalRule :: OrgElementData +horizontalRule = HorizontalRule + +table :: [TableRow] -> OrgElementData +table = Table + +standardRow :: [OrgObjects] -> TableRow +standardRow = StandardRow . map toList + +-- * Object builders + +plain :: Text -> OrgObjects +plain = one . Plain + +italic :: OrgObjects -> OrgObjects +italic = one . Italic . toList + +underline :: OrgObjects -> OrgObjects +underline = one . Underline . toList + +bold :: OrgObjects -> OrgObjects +bold = one . Bold . toList + +strikethrough :: OrgObjects -> OrgObjects +strikethrough = one . Strikethrough . toList + +superscript :: OrgObjects -> OrgObjects +superscript = one . Superscript . toList + +subscript :: OrgObjects -> OrgObjects +subscript = one . Subscript . toList + +singleQuoted :: OrgObjects -> OrgObjects +singleQuoted = quoted SingleQuote + +doubleQuoted :: OrgObjects -> OrgObjects +doubleQuoted = quoted DoubleQuote + +quoted :: QuoteType -> OrgObjects -> OrgObjects +quoted qt = one . Quoted qt . toList + +citation :: Citation -> OrgObjects +citation = one . Cite + +citation' :: Text -> Text -> OrgObjects -> OrgObjects -> [CiteReference] -> OrgObjects +citation' style variant prefix suffix = one . Cite . Citation style variant (toList prefix) (toList suffix) + +timestamp :: TimestampData -> OrgObjects +timestamp = one . Timestamp + +-- | Plain inline code. +code :: Text -> OrgObjects +code = one . Code + +-- | Inline verbatim. +verbatim :: Text -> OrgObjects +verbatim = one . Verbatim + +linebreak :: OrgObjects +linebreak = one LineBreak + +entity :: Text -> OrgObjects +entity = one . Entity + +fragment :: Text -> OrgObjects +fragment = one . LaTeXFragment RawFragment + +inlMath :: Text -> OrgObjects +inlMath = one . LaTeXFragment InlMathFragment + +dispMath :: Text -> OrgObjects +dispMath = one . LaTeXFragment DispMathFragment + +exportSnippet :: Text -> Text -> OrgObjects +exportSnippet backend = one . ExportSnippet backend + +inlBabel :: Text -> Text -> Text -> Text -> OrgObjects +inlBabel name h1 h2 args = one $ InlBabelCall (BabelCall name h1 h2 args) + +macro :: Text -> [Text] -> OrgObjects +macro = (one .) . Macro + +inlSrc :: Text -> Text -> Text -> OrgObjects +inlSrc name headers = one . Src name headers + +link :: LinkTarget -> OrgObjects -> OrgObjects +link tgt = one . Link tgt . toList + +uriLink :: Text -> Text -> OrgObjects -> OrgObjects +uriLink protocol tgt = one . Link (URILink protocol tgt) . toList + +target :: Id -> Text -> OrgObjects +target a = one . Target a + +footnoteLabel :: Text -> OrgObjects +footnoteLabel = one . FootnoteRef . FootnoteRefLabel + +footnoteInlDef :: Maybe Text -> OrgObjects -> OrgObjects +footnoteInlDef l = one . FootnoteRef . FootnoteRefDef l . toList + +statisticCookie :: Either (Int, Int) Int -> OrgObjects +statisticCookie = one . StatisticCookie diff --git a/src/Org/Compare.hs b/src/Org/Compare.hs new file mode 100644 --- /dev/null +++ b/src/Org/Compare.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} + +{- | This module implements comparasion of Org contents, using multiwalk. You + should use this instead of the default Ord instances when you want to compare + Org content semantically. +-} +module Org.Compare (compareContent, compareContents, toAtoms, Atom) where + +import Data.Text qualified as T +import Org.Types +import Org.Walk + +data Atom + = Separator + | Word Text + | Literal Text + | Time DateTime + deriving (Eq, Ord) + +compareContent :: MultiWalk MWTag a => a -> a -> Ordering +compareContent = comparing toAtoms + +compareContents :: MultiWalk MWTag a => [a] -> [a] -> Ordering +compareContents = comparing (foldMap toAtoms) + +toAtoms :: MultiWalk MWTag a => a -> [Atom] +toAtoms = buildMultiQ \f l -> + l ?> objToAtoms f ?> elmToAtoms f + +elmToAtoms :: Query [Atom] -> OrgElementData -> [Atom] +elmToAtoms f = (Separator :) . \case + ExportBlock _ t -> [Literal t] + ExampleBlock _ t -> [Literal $ srcLinesToText t] + SrcBlock {..} -> [Literal $ srcLinesToText srcBlkLines] + LaTeXEnvironment _ t -> [Literal t] + x -> f x + +objToAtoms :: Query [Atom] -> OrgObject -> [Atom] +objToAtoms f = \case + Plain t -> Word <$> T.words t + Code t -> [Literal t] + Verbatim t -> [Literal t] + Timestamp (TimestampData _ t) -> [Time t] + Timestamp (TimestampRange _ t s) -> [Time t, Time s] + Entity t -> [Literal t] + LaTeXFragment _ t -> [Literal t] + ExportSnippet _ t -> [Literal t] + FootnoteRef {} -> [] + Cite (Citation {..}) -> + (citationPrefix >>= toAtoms) + ++ ( citationReferences >>= \CiteReference {..} -> + (refPrefix >>= toAtoms) + ++ [Literal refId] + ++ (refSuffix >>= toAtoms) + ) + ++ (citationSuffix >>= toAtoms) + Src _ _ t -> [Literal t] + x -> f x diff --git a/src/Org/Data/Entities.hs b/src/Org/Data/Entities.hs new file mode 100644 --- /dev/null +++ b/src/Org/Data/Entities.hs @@ -0,0 +1,449 @@ +module Org.Data.Entities where + +data Entity = Entity + { entityName :: Text, + latexReplacement :: Text, + latexMathP :: Bool, + htmlReplacement :: Text, + asciiReplacement :: Text, + latin1Replacement :: Text, + utf8Replacement :: Text + } + deriving (Show, Eq, Ord, Read, Typeable, Generic) + +{- +Generated by the elisp function: + +(defun insert-entities () + (interactive) + (cl-loop for entity in org-entities do + (pcase entity + (`(,name ,tex ,mathp ,html ,ascii ,latin ,utf8) + (insert + (format " , Entity %S %S %s %S %S %S %S\n" + name tex (if mathp "True" "False") html ascii latin utf8)))))) + +-} + +defaultEntitiesNames :: [Text] +defaultEntitiesNames = map entityName defaultEntities + +defaultEntitiesMap :: Map Text Entity +defaultEntitiesMap = fromList $ map (\e -> (entityName e, e)) defaultEntities + +defaultEntities :: [Entity] +defaultEntities = + [ Entity "Agrave" "\\`{A}" False "À" "A" "À" "À", + Entity "agrave" "\\`{a}" False "à" "a" "à" "à", + Entity "Aacute" "\\'{A}" False "Á" "A" "Á" "Á", + Entity "aacute" "\\'{a}" False "á" "a" "á" "á", + Entity "Acirc" "\\^{A}" False "Â" "A" "Â" "Â", + Entity "acirc" "\\^{a}" False "â" "a" "â" "â", + Entity "Amacr" "\\={A}" False "Ā" "A" "Ã" "Ã", + Entity "amacr" "\\={a}" False "ā" "a" "ã" "ã", + Entity "Atilde" "\\~{A}" False "Ã" "A" "Ã" "Ã", + Entity "atilde" "\\~{a}" False "ã" "a" "ã" "ã", + Entity "Auml" "\\\"{A}" False "Ä" "Ae" "Ä" "Ä", + Entity "auml" "\\\"{a}" False "ä" "ae" "ä" "ä", + Entity "Aring" "\\AA{}" False "Å" "A" "Å" "Å", + Entity "AA" "\\AA{}" False "Å" "A" "Å" "Å", + Entity "aring" "\\aa{}" False "å" "a" "å" "å", + Entity "AElig" "\\AE{}" False "Æ" "AE" "Æ" "Æ", + Entity "aelig" "\\ae{}" False "æ" "ae" "æ" "æ", + Entity "Ccedil" "\\c{C}" False "Ç" "C" "Ç" "Ç", + Entity "ccedil" "\\c{c}" False "ç" "c" "ç" "ç", + Entity "Egrave" "\\`{E}" False "È" "E" "È" "È", + Entity "egrave" "\\`{e}" False "è" "e" "è" "è", + Entity "Eacute" "\\'{E}" False "É" "E" "É" "É", + Entity "eacute" "\\'{e}" False "é" "e" "é" "é", + Entity "Ecirc" "\\^{E}" False "Ê" "E" "Ê" "Ê", + Entity "ecirc" "\\^{e}" False "ê" "e" "ê" "ê", + Entity "Euml" "\\\"{E}" False "Ë" "E" "Ë" "Ë", + Entity "euml" "\\\"{e}" False "ë" "e" "ë" "ë", + Entity "Igrave" "\\`{I}" False "Ì" "I" "Ì" "Ì", + Entity "igrave" "\\`{i}" False "ì" "i" "ì" "ì", + Entity "Iacute" "\\'{I}" False "Í" "I" "Í" "Í", + Entity "iacute" "\\'{i}" False "í" "i" "í" "í", + Entity "Idot" "\\.{I}" False "&idot;" "I" "İ" "İ", + Entity "inodot" "\\i" False "ı" "i" "ı" "ı", + Entity "Icirc" "\\^{I}" False "Î" "I" "Î" "Î", + Entity "icirc" "\\^{i}" False "î" "i" "î" "î", + Entity "Iuml" "\\\"{I}" False "Ï" "I" "Ï" "Ï", + Entity "iuml" "\\\"{i}" False "ï" "i" "ï" "ï", + Entity "Ntilde" "\\~{N}" False "Ñ" "N" "Ñ" "Ñ", + Entity "ntilde" "\\~{n}" False "ñ" "n" "ñ" "ñ", + Entity "Ograve" "\\`{O}" False "Ò" "O" "Ò" "Ò", + Entity "ograve" "\\`{o}" False "ò" "o" "ò" "ò", + Entity "Oacute" "\\'{O}" False "Ó" "O" "Ó" "Ó", + Entity "oacute" "\\'{o}" False "ó" "o" "ó" "ó", + Entity "Ocirc" "\\^{O}" False "Ô" "O" "Ô" "Ô", + Entity "ocirc" "\\^{o}" False "ô" "o" "ô" "ô", + Entity "Otilde" "\\~{O}" False "Õ" "O" "Õ" "Õ", + Entity "otilde" "\\~{o}" False "õ" "o" "õ" "õ", + Entity "Ouml" "\\\"{O}" False "Ö" "Oe" "Ö" "Ö", + Entity "ouml" "\\\"{o}" False "ö" "oe" "ö" "ö", + Entity "Oslash" "\\O" False "Ø" "O" "Ø" "Ø", + Entity "oslash" "\\o{}" False "ø" "o" "ø" "ø", + Entity "OElig" "\\OE{}" False "Œ" "OE" "OE" "Œ", + Entity "oelig" "\\oe{}" False "œ" "oe" "oe" "œ", + Entity "Scaron" "\\v{S}" False "Š" "S" "S" "Š", + Entity "scaron" "\\v{s}" False "š" "s" "s" "š", + Entity "szlig" "\\ss{}" False "ß" "ss" "ß" "ß", + Entity "Ugrave" "\\`{U}" False "Ù" "U" "Ù" "Ù", + Entity "ugrave" "\\`{u}" False "ù" "u" "ù" "ù", + Entity "Uacute" "\\'{U}" False "Ú" "U" "Ú" "Ú", + Entity "uacute" "\\'{u}" False "ú" "u" "ú" "ú", + Entity "Ucirc" "\\^{U}" False "Û" "U" "Û" "Û", + Entity "ucirc" "\\^{u}" False "û" "u" "û" "û", + Entity "Uuml" "\\\"{U}" False "Ü" "Ue" "Ü" "Ü", + Entity "uuml" "\\\"{u}" False "ü" "ue" "ü" "ü", + Entity "Yacute" "\\'{Y}" False "Ý" "Y" "Ý" "Ý", + Entity "yacute" "\\'{y}" False "ý" "y" "ý" "ý", + Entity "Yuml" "\\\"{Y}" False "Ÿ" "Y" "Y" "Ÿ", + Entity "yuml" "\\\"{y}" False "ÿ" "y" "ÿ" "ÿ", + Entity "fnof" "\\textit{f}" False "ƒ" "f" "f" "ƒ", + Entity "real" "\\Re" True "ℜ" "R" "R" "ℜ", + Entity "image" "\\Im" True "ℑ" "I" "I" "ℑ", + Entity "weierp" "\\wp" True "℘" "P" "P" "℘", + Entity "ell" "\\ell" True "ℓ" "ell" "ell" "ℓ", + Entity "imath" "\\imath" True "ı" "[dotless i]" "dotless i" "ı", + Entity "jmath" "\\jmath" True "ȷ" "[dotless j]" "dotless j" "ȷ", + Entity "Alpha" "A" False "Α" "Alpha" "Alpha" "Α", + Entity "alpha" "\\alpha" True "α" "alpha" "alpha" "α", + Entity "Beta" "B" False "Β" "Beta" "Beta" "Β", + Entity "beta" "\\beta" True "β" "beta" "beta" "β", + Entity "Gamma" "\\Gamma" True "Γ" "Gamma" "Gamma" "Γ", + Entity "gamma" "\\gamma" True "γ" "gamma" "gamma" "γ", + Entity "Delta" "\\Delta" True "Δ" "Delta" "Delta" "Δ", + Entity "delta" "\\delta" True "δ" "delta" "delta" "δ", + Entity "Epsilon" "E" False "Ε" "Epsilon" "Epsilon" "Ε", + Entity "epsilon" "\\epsilon" True "ε" "epsilon" "epsilon" "ε", + Entity "varepsilon" "\\varepsilon" True "ε" "varepsilon" "varepsilon" "ε", + Entity "Zeta" "Z" False "Ζ" "Zeta" "Zeta" "Ζ", + Entity "zeta" "\\zeta" True "ζ" "zeta" "zeta" "ζ", + Entity "Eta" "H" False "Η" "Eta" "Eta" "Η", + Entity "eta" "\\eta" True "η" "eta" "eta" "η", + Entity "Theta" "\\Theta" True "Θ" "Theta" "Theta" "Θ", + Entity "theta" "\\theta" True "θ" "theta" "theta" "θ", + Entity "thetasym" "\\vartheta" True "ϑ" "theta" "theta" "ϑ", + Entity "vartheta" "\\vartheta" True "ϑ" "theta" "theta" "ϑ", + Entity "Iota" "I" False "Ι" "Iota" "Iota" "Ι", + Entity "iota" "\\iota" True "ι" "iota" "iota" "ι", + Entity "Kappa" "K" False "Κ" "Kappa" "Kappa" "Κ", + Entity "kappa" "\\kappa" True "κ" "kappa" "kappa" "κ", + Entity "Lambda" "\\Lambda" True "Λ" "Lambda" "Lambda" "Λ", + Entity "lambda" "\\lambda" True "λ" "lambda" "lambda" "λ", + Entity "Mu" "M" False "Μ" "Mu" "Mu" "Μ", + Entity "mu" "\\mu" True "μ" "mu" "mu" "μ", + Entity "nu" "\\nu" True "ν" "nu" "nu" "ν", + Entity "Nu" "N" False "Ν" "Nu" "Nu" "Ν", + Entity "Xi" "\\Xi" True "Ξ" "Xi" "Xi" "Ξ", + Entity "xi" "\\xi" True "ξ" "xi" "xi" "ξ", + Entity "Omicron" "O" False "Ο" "Omicron" "Omicron" "Ο", + Entity "omicron" "\\textit{o}" False "ο" "omicron" "omicron" "ο", + Entity "Pi" "\\Pi" True "Π" "Pi" "Pi" "Π", + Entity "pi" "\\pi" True "π" "pi" "pi" "π", + Entity "Rho" "P" False "Ρ" "Rho" "Rho" "Ρ", + Entity "rho" "\\rho" True "ρ" "rho" "rho" "ρ", + Entity "Sigma" "\\Sigma" True "Σ" "Sigma" "Sigma" "Σ", + Entity "sigma" "\\sigma" True "σ" "sigma" "sigma" "σ", + Entity "sigmaf" "\\varsigma" True "ς" "sigmaf" "sigmaf" "ς", + Entity "varsigma" "\\varsigma" True "ς" "varsigma" "varsigma" "ς", + Entity "Tau" "T" False "Τ" "Tau" "Tau" "Τ", + Entity "Upsilon" "\\Upsilon" True "Υ" "Upsilon" "Upsilon" "Υ", + Entity "upsih" "\\Upsilon" True "ϒ" "upsilon" "upsilon" "ϒ", + Entity "upsilon" "\\upsilon" True "υ" "upsilon" "upsilon" "υ", + Entity "Phi" "\\Phi" True "Φ" "Phi" "Phi" "Φ", + Entity "phi" "\\phi" True "φ" "phi" "phi" "ɸ", + Entity "varphi" "\\varphi" True "ϕ" "varphi" "varphi" "φ", + Entity "Chi" "X" False "Χ" "Chi" "Chi" "Χ", + Entity "chi" "\\chi" True "χ" "chi" "chi" "χ", + Entity "acutex" "\\acute x" True "´x" "'x" "'x" "𝑥́", + Entity "Psi" "\\Psi" True "Ψ" "Psi" "Psi" "Ψ", + Entity "psi" "\\psi" True "ψ" "psi" "psi" "ψ", + Entity "tau" "\\tau" True "τ" "tau" "tau" "τ", + Entity "Omega" "\\Omega" True "Ω" "Omega" "Omega" "Ω", + Entity "omega" "\\omega" True "ω" "omega" "omega" "ω", + Entity "piv" "\\varpi" True "ϖ" "omega-pi" "omega-pi" "ϖ", + Entity "varpi" "\\varpi" True "ϖ" "omega-pi" "omega-pi" "ϖ", + Entity "partial" "\\partial" True "∂" "[partial differential]" "[partial differential]" "∂", + Entity "alefsym" "\\aleph" True "ℵ" "aleph" "aleph" "ℵ", + Entity "aleph" "\\aleph" True "ℵ" "aleph" "aleph" "ℵ", + Entity "gimel" "\\gimel" True "ℷ" "gimel" "gimel" "ℷ", + Entity "beth" "\\beth" True "ℶ" "beth" "beth" "ב", + Entity "dalet" "\\daleth" True "ℸ" "dalet" "dalet" "ד", + Entity "ETH" "\\DH{}" False "Ð" "D" "Ð" "Ð", + Entity "eth" "\\dh{}" False "ð" "dh" "ð" "ð", + Entity "THORN" "\\TH{}" False "Þ" "TH" "Þ" "Þ", + Entity "thorn" "\\th{}" False "þ" "th" "þ" "þ", + Entity "dots" "\\dots{}" False "…" "..." "..." "…", + Entity "cdots" "\\cdots{}" True "⋯" "..." "..." "⋯", + Entity "hellip" "\\dots{}" False "…" "..." "..." "…", + Entity "middot" "\\textperiodcentered{}" False "·" "." "·" "·", + Entity "iexcl" "!`" False "¡" "!" "¡" "¡", + Entity "iquest" "?`" False "¿" "?" "¿" "¿", + Entity "shy" "\\-" False "­" "" "" "", + Entity "ndash" "--" False "–" "-" "-" "–", + Entity "mdash" "---" False "—" "--" "--" "—", + Entity "quot" "\\textquotedbl{}" False """ "\"" "\"" "\"", + Entity "acute" "\\textasciiacute{}" False "´" "'" "´" "´", + Entity "ldquo" "\\textquotedblleft{}" False "“" "\"" "\"" "“", + Entity "rdquo" "\\textquotedblright{}" False "”" "\"" "\"" "”", + Entity "bdquo" "\\quotedblbase{}" False "„" "\"" "\"" "„", + Entity "lsquo" "\\textquoteleft{}" False "‘" "`" "`" "‘", + Entity "rsquo" "\\textquoteright{}" False "’" "'" "'" "’", + Entity "sbquo" "\\quotesinglbase{}" False "‚" "," "," "‚", + Entity "laquo" "\\guillemotleft{}" False "«" "<<" "«" "«", + Entity "raquo" "\\guillemotright{}" False "»" ">>" "»" "»", + Entity "lsaquo" "\\guilsinglleft{}" False "‹" "<" "<" "‹", + Entity "rsaquo" "\\guilsinglright{}" False "›" ">" ">" "›", + Entity "circ" "\\^{}" False "ˆ" "^" "^" "∘", + Entity "vert" "\\vert{}" True "|" "|" "|" "|", + Entity "vbar" "|" False "|" "|" "|" "|", + Entity "brvbar" "\\textbrokenbar{}" False "¦" "|" "¦" "¦", + Entity "S" "\\S" False "§" "paragraph" "§" "§", + Entity "sect" "\\S" False "§" "paragraph" "§" "§", + Entity "amp" "\\&" False "&" "&" "&" "&", + Entity "lt" "\\textless{}" False "<" "<" "<" "<", + Entity "gt" "\\textgreater{}" False ">" ">" ">" ">", + Entity "tilde" "\\textasciitilde{}" False "~" "~" "~" "~", + Entity "slash" "/" False "/" "/" "/" "/", + Entity "plus" "+" False "+" "+" "+" "+", + Entity "under" "\\_" False "_" "_" "_" "_", + Entity "equal" "=" False "=" "=" "=" "=", + Entity "asciicirc" "\\textasciicircum{}" False "^" "^" "^" "^", + Entity "dagger" "\\textdagger{}" False "†" "[dagger]" "[dagger]" "†", + Entity "dag" "\\dag{}" False "†" "[dagger]" "[dagger]" "†", + Entity "Dagger" "\\textdaggerdbl{}" False "‡" "[doubledagger]" "[doubledagger]" "‡", + Entity "ddag" "\\ddag{}" False "‡" "[doubledagger]" "[doubledagger]" "‡", + Entity "nbsp" "~" False " " " " " " " ", + Entity "ensp" "\\hspace*{.5em}" False " " " " " " " ", + Entity "emsp" "\\hspace*{1em}" False " " " " " " " ", + Entity "thinsp" "\\hspace*{.2em}" False " " " " " " " ", + Entity "curren" "\\textcurrency{}" False "¤" "curr." "¤" "¤", + Entity "cent" "\\textcent{}" False "¢" "cent" "¢" "¢", + Entity "pound" "\\pounds{}" False "£" "pound" "£" "£", + Entity "yen" "\\textyen{}" False "¥" "yen" "¥" "¥", + Entity "euro" "\\texteuro{}" False "€" "EUR" "EUR" "€", + Entity "EUR" "\\texteuro{}" False "€" "EUR" "EUR" "€", + Entity "dollar" "\\$" False "$" "$" "$" "$", + Entity "USD" "\\$" False "$" "$" "$" "$", + Entity "copy" "\\textcopyright{}" False "©" "(c)" "©" "©", + Entity "reg" "\\textregistered{}" False "®" "(r)" "®" "®", + Entity "trade" "\\texttrademark{}" False "™" "TM" "TM" "™", + Entity "minus" "\\minus" True "−" "-" "-" "−", + Entity "pm" "\\textpm{}" False "±" "+-" "±" "±", + Entity "plusmn" "\\textpm{}" False "±" "+-" "±" "±", + Entity "times" "\\texttimes{}" False "×" "*" "×" "×", + Entity "frasl" "/" False "⁄" "/" "/" "⁄", + Entity "colon" "\\colon" True ":" ":" ":" ":", + Entity "div" "\\textdiv{}" False "÷" "/" "÷" "÷", + Entity "frac12" "\\textonehalf{}" False "½" "1/2" "½" "½", + Entity "frac14" "\\textonequarter{}" False "¼" "1/4" "¼" "¼", + Entity "frac34" "\\textthreequarters{}" False "¾" "3/4" "¾" "¾", + Entity "permil" "\\textperthousand{}" False "‰" "per thousand" "per thousand" "‰", + Entity "sup1" "\\textonesuperior{}" False "¹" "^1" "¹" "¹", + Entity "sup2" "\\texttwosuperior{}" False "²" "^2" "²" "²", + Entity "sup3" "\\textthreesuperior{}" False "³" "^3" "³" "³", + Entity "radic" "\\sqrt{\\,}" True "√" "[square root]" "[square root]" "√", + Entity "sum" "\\sum" True "∑" "[sum]" "[sum]" "∑", + Entity "prod" "\\prod" True "∏" "[product]" "[n-ary product]" "∏", + Entity "micro" "\\textmu{}" False "µ" "micro" "µ" "µ", + Entity "macr" "\\textasciimacron{}" False "¯" "[macron]" "¯" "¯", + Entity "deg" "\\textdegree{}" False "°" "degree" "°" "°", + Entity "prime" "\\prime" True "′" "'" "'" "′", + Entity "Prime" "\\prime{}\\prime" True "″" "''" "''" "″", + Entity "infin" "\\infty" True "∞" "[infinity]" "[infinity]" "∞", + Entity "infty" "\\infty" True "∞" "[infinity]" "[infinity]" "∞", + Entity "prop" "\\propto" True "∝" "[proportional to]" "[proportional to]" "∝", + Entity "propto" "\\propto" True "∝" "[proportional to]" "[proportional to]" "∝", + Entity "not" "\\textlnot{}" False "¬" "[angled dash]" "¬" "¬", + Entity "neg" "\\neg{}" True "¬" "[angled dash]" "¬" "¬", + Entity "land" "\\land" True "∧" "[logical and]" "[logical and]" "∧", + Entity "wedge" "\\wedge" True "∧" "[logical and]" "[logical and]" "∧", + Entity "lor" "\\lor" True "∨" "[logical or]" "[logical or]" "∨", + Entity "vee" "\\vee" True "∨" "[logical or]" "[logical or]" "∨", + Entity "cap" "\\cap" True "∩" "[intersection]" "[intersection]" "∩", + Entity "cup" "\\cup" True "∪" "[union]" "[union]" "∪", + Entity "smile" "\\smile" True "⌣" "[cup product]" "[cup product]" "⌣", + Entity "frown" "\\frown" True "⌢" "[Cap product]" "[cap product]" "⌢", + Entity "int" "\\int" True "∫" "[integral]" "[integral]" "∫", + Entity "therefore" "\\therefore" True "∴" "[therefore]" "[therefore]" "∴", + Entity "there4" "\\therefore" True "∴" "[therefore]" "[therefore]" "∴", + Entity "because" "\\because" True "∵" "[because]" "[because]" "∵", + Entity "sim" "\\sim" True "∼" "~" "~" "∼", + Entity "cong" "\\cong" True "≅" "[approx. equal to]" "[approx. equal to]" "≅", + Entity "simeq" "\\simeq" True "≅" "[approx. equal to]" "[approx. equal to]" "≅", + Entity "asymp" "\\asymp" True "≈" "[almost equal to]" "[almost equal to]" "≈", + Entity "approx" "\\approx" True "≈" "[almost equal to]" "[almost equal to]" "≈", + Entity "ne" "\\ne" True "≠" "[not equal to]" "[not equal to]" "≠", + Entity "neq" "\\neq" True "≠" "[not equal to]" "[not equal to]" "≠", + Entity "equiv" "\\equiv" True "≡" "[identical to]" "[identical to]" "≡", + Entity "triangleq" "\\triangleq" True "≜" "[defined to]" "[defined to]" "≜", + Entity "le" "\\le" True "≤" "<=" "<=" "≤", + Entity "leq" "\\le" True "≤" "<=" "<=" "≤", + Entity "ge" "\\ge" True "≥" ">=" ">=" "≥", + Entity "geq" "\\ge" True "≥" ">=" ">=" "≥", + Entity "lessgtr" "\\lessgtr" True "≶" "[less than or greater than]" "[less than or greater than]" "≶", + Entity "lesseqgtr" "\\lesseqgtr" True "⋚" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚", + Entity "ll" "\\ll" True "≪" "<<" "<<" "≪", + Entity "Ll" "\\lll" True "⋘" "<<<" "<<<" "⋘", + Entity "lll" "\\lll" True "⋘" "<<<" "<<<" "⋘", + Entity "gg" "\\gg" True "≫" ">>" ">>" "≫", + Entity "Gg" "\\ggg" True "⋙" ">>>" ">>>" "⋙", + Entity "ggg" "\\ggg" True "⋙" ">>>" ">>>" "⋙", + Entity "prec" "\\prec" True "≺" "[precedes]" "[precedes]" "≺", + Entity "preceq" "\\preceq" True "≼" "[precedes or equal]" "[precedes or equal]" "≼", + Entity "preccurlyeq" "\\preccurlyeq" True "≼" "[precedes or equal]" "[precedes or equal]" "≼", + Entity "succ" "\\succ" True "≻" "[succeeds]" "[succeeds]" "≻", + Entity "succeq" "\\succeq" True "≽" "[succeeds or equal]" "[succeeds or equal]" "≽", + Entity "succcurlyeq" "\\succcurlyeq" True "≽" "[succeeds or equal]" "[succeeds or equal]" "≽", + Entity "sub" "\\subset" True "⊂" "[subset of]" "[subset of]" "⊂", + Entity "subset" "\\subset" True "⊂" "[subset of]" "[subset of]" "⊂", + Entity "sup" "\\supset" True "⊃" "[superset of]" "[superset of]" "⊃", + Entity "supset" "\\supset" True "⊃" "[superset of]" "[superset of]" "⊃", + Entity "nsub" "\\not\\subset" True "⊄" "[not a subset of]" "[not a subset of" "⊄", + Entity "sube" "\\subseteq" True "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆", + Entity "nsup" "\\not\\supset" True "⊅" "[not a superset of]" "[not a superset of]" "⊅", + Entity "supe" "\\supseteq" True "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇", + Entity "setminus" "\\setminus" True "∖" "\\" " \\" "⧵", + Entity "forall" "\\forall" True "∀" "[for all]" "[for all]" "∀", + Entity "exist" "\\exists" True "∃" "[there exists]" "[there exists]" "∃", + Entity "exists" "\\exists" True "∃" "[there exists]" "[there exists]" "∃", + Entity "nexist" "\\nexists" True "∃" "[there does not exists]" "[there does not exists]" "∄", + Entity "nexists" "\\nexists" True "∃" "[there does not exists]" "[there does not exists]" "∄", + Entity "empty" "\\emptyset" True "∅" "[empty set]" "[empty set]" "∅", + Entity "emptyset" "\\emptyset" True "∅" "[empty set]" "[empty set]" "∅", + Entity "isin" "\\in" True "∈" "[element of]" "[element of]" "∈", + Entity "in" "\\in" True "∈" "[element of]" "[element of]" "∈", + Entity "notin" "\\notin" True "∉" "[not an element of]" "[not an element of]" "∉", + Entity "ni" "\\ni" True "∋" "[contains as member]" "[contains as member]" "∋", + Entity "nabla" "\\nabla" True "∇" "[nabla]" "[nabla]" "∇", + Entity "ang" "\\angle" True "∠" "[angle]" "[angle]" "∠", + Entity "angle" "\\angle" True "∠" "[angle]" "[angle]" "∠", + Entity "perp" "\\perp" True "⊥" "[up tack]" "[up tack]" "⊥", + Entity "parallel" "\\parallel" True "∥" "||" "||" "∥", + Entity "sdot" "\\cdot" True "⋅" "[dot]" "[dot]" "⋅", + Entity "cdot" "\\cdot" True "⋅" "[dot]" "[dot]" "⋅", + Entity "lceil" "\\lceil" True "⌈" "[left ceiling]" "[left ceiling]" "⌈", + Entity "rceil" "\\rceil" True "⌉" "[right ceiling]" "[right ceiling]" "⌉", + Entity "lfloor" "\\lfloor" True "⌊" "[left floor]" "[left floor]" "⌊", + Entity "rfloor" "\\rfloor" True "⌋" "[right floor]" "[right floor]" "⌋", + Entity "lang" "\\langle" True "⟨" "<" "<" "⟨", + Entity "rang" "\\rangle" True "⟩" ">" ">" "⟩", + Entity "langle" "\\langle" True "⟨" "<" "<" "⟨", + Entity "rangle" "\\rangle" True "⟩" ">" ">" "⟩", + Entity "hbar" "\\hbar" True "ℏ" "hbar" "hbar" "ℏ", + Entity "mho" "\\mho" True "℧" "mho" "mho" "℧", + Entity "larr" "\\leftarrow" True "←" "<-" "<-" "←", + Entity "leftarrow" "\\leftarrow" True "←" "<-" "<-" "←", + Entity "gets" "\\gets" True "←" "<-" "<-" "←", + Entity "lArr" "\\Leftarrow" True "⇐" "<=" "<=" "⇐", + Entity "Leftarrow" "\\Leftarrow" True "⇐" "<=" "<=" "⇐", + Entity "uarr" "\\uparrow" True "↑" "[uparrow]" "[uparrow]" "↑", + Entity "uparrow" "\\uparrow" True "↑" "[uparrow]" "[uparrow]" "↑", + Entity "uArr" "\\Uparrow" True "⇑" "[dbluparrow]" "[dbluparrow]" "⇑", + Entity "Uparrow" "\\Uparrow" True "⇑" "[dbluparrow]" "[dbluparrow]" "⇑", + Entity "rarr" "\\rightarrow" True "→" "->" "->" "→", + Entity "to" "\\to" True "→" "->" "->" "→", + Entity "rightarrow" "\\rightarrow" True "→" "->" "->" "→", + Entity "rArr" "\\Rightarrow" True "⇒" "=>" "=>" "⇒", + Entity "Rightarrow" "\\Rightarrow" True "⇒" "=>" "=>" "⇒", + Entity "darr" "\\downarrow" True "↓" "[downarrow]" "[downarrow]" "↓", + Entity "downarrow" "\\downarrow" True "↓" "[downarrow]" "[downarrow]" "↓", + Entity "dArr" "\\Downarrow" True "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓", + Entity "Downarrow" "\\Downarrow" True "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓", + Entity "harr" "\\leftrightarrow" True "↔" "<->" "<->" "↔", + Entity "leftrightarrow" "\\leftrightarrow" True "↔" "<->" "<->" "↔", + Entity "hArr" "\\Leftrightarrow" True "⇔" "<=>" "<=>" "⇔", + Entity "Leftrightarrow" "\\Leftrightarrow" True "⇔" "<=>" "<=>" "⇔", + Entity "crarr" "\\hookleftarrow" True "↵" "<-'" "<-'" "↵", + Entity "hookleftarrow" "\\hookleftarrow" True "↵" "<-'" "<-'" "↵", + Entity "arccos" "\\arccos" True "arccos" "arccos" "arccos" "arccos", + Entity "arcsin" "\\arcsin" True "arcsin" "arcsin" "arcsin" "arcsin", + Entity "arctan" "\\arctan" True "arctan" "arctan" "arctan" "arctan", + Entity "arg" "\\arg" True "arg" "arg" "arg" "arg", + Entity "cos" "\\cos" True "cos" "cos" "cos" "cos", + Entity "cosh" "\\cosh" True "cosh" "cosh" "cosh" "cosh", + Entity "cot" "\\cot" True "cot" "cot" "cot" "cot", + Entity "coth" "\\coth" True "coth" "coth" "coth" "coth", + Entity "csc" "\\csc" True "csc" "csc" "csc" "csc", + Entity "deg" "\\deg" True "°" "deg" "deg" "deg", + Entity "det" "\\det" True "det" "det" "det" "det", + Entity "dim" "\\dim" True "dim" "dim" "dim" "dim", + Entity "exp" "\\exp" True "exp" "exp" "exp" "exp", + Entity "gcd" "\\gcd" True "gcd" "gcd" "gcd" "gcd", + Entity "hom" "\\hom" True "hom" "hom" "hom" "hom", + Entity "inf" "\\inf" True "inf" "inf" "inf" "inf", + Entity "ker" "\\ker" True "ker" "ker" "ker" "ker", + Entity "lg" "\\lg" True "lg" "lg" "lg" "lg", + Entity "lim" "\\lim" True "lim" "lim" "lim" "lim", + Entity "liminf" "\\liminf" True "liminf" "liminf" "liminf" "liminf", + Entity "limsup" "\\limsup" True "limsup" "limsup" "limsup" "limsup", + Entity "ln" "\\ln" True "ln" "ln" "ln" "ln", + Entity "log" "\\log" True "log" "log" "log" "log", + Entity "max" "\\max" True "max" "max" "max" "max", + Entity "min" "\\min" True "min" "min" "min" "min", + Entity "Pr" "\\Pr" True "Pr" "Pr" "Pr" "Pr", + Entity "sec" "\\sec" True "sec" "sec" "sec" "sec", + Entity "sin" "\\sin" True "sin" "sin" "sin" "sin", + Entity "sinh" "\\sinh" True "sinh" "sinh" "sinh" "sinh", + Entity "sup" "\\sup" True "⊃" "sup" "sup" "sup", + Entity "tan" "\\tan" True "tan" "tan" "tan" "tan", + Entity "tanh" "\\tanh" True "tanh" "tanh" "tanh" "tanh", + Entity "bull" "\\textbullet{}" False "•" "*" "*" "•", + Entity "bullet" "\\textbullet{}" False "•" "*" "*" "•", + Entity "star" "\\star" True "*" "*" "*" "⋆", + Entity "lowast" "\\ast" True "∗" "*" "*" "∗", + Entity "ast" "\\ast" True "∗" "*" "*" "*", + Entity "odot" "\\odot" True "o" "[circled dot]" "[circled dot]" "ʘ", + Entity "oplus" "\\oplus" True "⊕" "[circled plus]" "[circled plus]" "⊕", + Entity "otimes" "\\otimes" True "⊗" "[circled times]" "[circled times]" "⊗", + Entity "check" "\\checkmark" True "✓" "[checkmark]" "[checkmark]" "✓", + Entity "checkmark" "\\checkmark" True "✓" "[checkmark]" "[checkmark]" "✓", + Entity "para" "\\P{}" False "¶" "[pilcrow]" "¶" "¶", + Entity "ordf" "\\textordfeminine{}" False "ª" "_a_" "ª" "ª", + Entity "ordm" "\\textordmasculine{}" False "º" "_o_" "º" "º", + Entity "cedil" "\\c{}" False "¸" "[cedilla]" "¸" "¸", + Entity "oline" "\\overline{~}" True "‾" "[overline]" "¯" "‾", + Entity "uml" "\\textasciidieresis{}" False "¨" "[diaeresis]" "¨" "¨", + Entity "zwnj" "\\/{}" False "‌" "" "" "\8204", + Entity "zwj" "" False "‍" "" "" "\8205", + Entity "lrm" "" False "‎" "" "" "\8206", + Entity "rlm" "" False "‏" "" "" "\8207", + Entity "smiley" "\\ddot\\smile" True "☺" ":-)" ":-)" "☺", + Entity "blacksmile" "\\ddot\\smile" True "☻" ":-)" ":-)" "☻", + Entity "sad" "\\ddot\\frown" True "☹" ":-(" ":-(" "☹", + Entity "frowny" "\\ddot\\frown" True "☹" ":-(" ":-(" "☹", + Entity "clubs" "\\clubsuit" True "♣" "[clubs]" "[clubs]" "♣", + Entity "clubsuit" "\\clubsuit" True "♣" "[clubs]" "[clubs]" "♣", + Entity "spades" "\\spadesuit" True "♠" "[spades]" "[spades]" "♠", + Entity "spadesuit" "\\spadesuit" True "♠" "[spades]" "[spades]" "♠", + Entity "hearts" "\\heartsuit" True "♥" "[hearts]" "[hearts]" "♥", + Entity "heartsuit" "\\heartsuit" True "♥" "[hearts]" "[hearts]" "♥", + Entity "diams" "\\diamondsuit" True "♦" "[diamonds]" "[diamonds]" "◆", + Entity "diamondsuit" "\\diamondsuit" True "♦" "[diamonds]" "[diamonds]" "◆", + Entity "diamond" "\\diamondsuit" True "⋄" "[diamond]" "[diamond]" "◆", + Entity "Diamond" "\\diamondsuit" True "⋄" "[diamond]" "[diamond]" "◆", + Entity "loz" "\\lozenge" True "◊" "[lozenge]" "[lozenge]" "⧫", + Entity "_ " "\\hspace*{0.5em}" False " " " " " " " ", + Entity "_ " "\\hspace*{1.0em}" False "  " " " " " "  ", + Entity "_ " "\\hspace*{1.5em}" False "   " " " " " "   ", + Entity "_ " "\\hspace*{2.0em}" False "    " " " " " "    ", + Entity "_ " "\\hspace*{2.5em}" False "     " " " " " "     ", + Entity "_ " "\\hspace*{3.0em}" False "      " " " " " "      ", + Entity "_ " "\\hspace*{3.5em}" False "       " " " " " "       ", + Entity "_ " "\\hspace*{4.0em}" False "        " " " " " "        ", + Entity "_ " "\\hspace*{4.5em}" False "         " " " " " "         ", + Entity "_ " "\\hspace*{5.0em}" False "          " " " " " "          ", + Entity "_ " "\\hspace*{5.5em}" False "           " " " " " "           ", + Entity "_ " "\\hspace*{6.0em}" False "            " " " " " "            ", + Entity "_ " "\\hspace*{6.5em}" False "             " " " " " "             ", + Entity "_ " "\\hspace*{7.0em}" False "              " " " " " "              ", + Entity "_ " "\\hspace*{7.5em}" False "               " " " " " "               ", + Entity "_ " "\\hspace*{8.0em}" False "                " " " " " "                ", + Entity "_ " "\\hspace*{8.5em}" False "                 " " " " " "                 ", + Entity "_ " "\\hspace*{9.0em}" False "                  " " " " " "                  ", + Entity "_ " "\\hspace*{9.5em}" False "                   " " " " " "                   ", + Entity "_ " "\\hspace*{10.0em}" False "                    " " " " " "                    " + ] diff --git a/src/Org/Parser.hs b/src/Org/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Org/Parser.hs @@ -0,0 +1,43 @@ +module Org.Parser + ( OrgParser + , OrgParseError + , OrgOptions (..) + , TodoSequence + , defaultOrgOptions + , parseOrgMaybe + , parseOrg + , parseOrgDoc + , parseOrgDocIO + ) +where + +import Org.Parser.Definitions +import Org.Parser.Document + +{- | Evaluate the Org Parser state with the desired options. Returns 'Nothing' in + case of parse failure. +-} +parseOrgMaybe :: OrgOptions -> OrgParser a -> Text -> Maybe a +parseOrgMaybe opt p = rightToMaybe . parseOrg opt p "" + +{- | Wrapper around 'parse' that evaluates the Org Parser state with the desired + options. +-} +parseOrg :: OrgOptions -> OrgParser a -> FilePath -> Text -> Either OrgParseError a +parseOrg opt (OrgParser x) = + parse $ + x + `runReaderT` defaultEnv {orgEnvOptions = opt} + `evalStateT` defaultState + +-- | Parse an Org document fully, with given options, and a filepath for error messages. +parseOrgDoc :: OrgOptions -> FilePath -> Text -> Either OrgParseError OrgDocument +parseOrgDoc opt = parseOrg opt orgDocument + +-- | Parse an Org document in a UTF8 file, with given options. +parseOrgDocIO :: MonadIO m => OrgOptions -> FilePath -> m OrgDocument +parseOrgDocIO opt fp = do + text <- readFileBS fp + case parseOrgDoc opt fp $ decodeUtf8 text of + Left e -> error . toText $ errorBundlePretty e + Right d -> pure d diff --git a/src/Org/Parser/Common.hs b/src/Org/Parser/Common.hs new file mode 100644 --- /dev/null +++ b/src/Org/Parser/Common.hs @@ -0,0 +1,208 @@ +module Org.Parser.Common where + +import Data.Char (digitToInt, isAsciiLower, isAsciiUpper) +import Data.Text qualified as T +import Org.Parser.Definitions +import Prelude hiding (State, many, some) + +-- | Read the start of a header line, return the header level +headingStart :: OrgParser Int +headingStart = + try $ + (T.length <$> takeWhile1P (Just "heading bullets") (== '*')) + <* char ' ' + <* skipSpaces + +parseTime :: OrgParser Time +parseTime = do + hour <- (number 2 <|> number 1) <* char ':' + minute <- number 2 + pure (hour, minute) + +-- | The same as 'string'', but cheaper (?) +string'' :: MonadParser m => Text -> m Text +string'' = tokens ((==) `on` T.toLower) +{-# INLINE string'' #-} + +digitIntChar :: MonadParser m => m Int +digitIntChar = digitToInt <$> digitChar + +digits :: MonadParser m => m Text +digits = takeWhileP (Just "digits") isDigit + +digits1 :: MonadParser m => m Text +digits1 = takeWhile1P (Just "digits") isDigit + +integer :: MonadParser m => m Int +integer = try $ do + digits' <- reverse <$> some digitIntChar + let toInt (x : xs) = 10 * toInt xs + x + toInt [] = 0 + pure $ toInt digits' + +number :: + Int -> + OrgParser Int +number 1 = digitIntChar +number n | n > 1 = try $ do + d <- digitIntChar + (10 ^ (n - 1) * d +) <$> number (n - 1) +number _ = error "Number of digits to parse must be positive!" + +-- * ASCII alphabet character classes + +isAsciiAlpha :: Char -> Bool +isAsciiAlpha c = isAsciiLower c || isAsciiUpper c + +upperAscii' :: MonadParser m => m Int +upperAscii' = do + c <- upperAscii + pure $ ord c - ord 'A' + 1 + +lowerAscii' :: MonadParser m => m Int +lowerAscii' = do + c <- lowerAscii + pure $ ord c - ord 'a' + 1 + +asciiAlpha' :: MonadParser m => m Int +asciiAlpha' = lowerAscii' <|> upperAscii' + +upperAscii :: MonadParser m => m Char +upperAscii = + satisfy isAsciiUpper + "uppercase A-Z character" + +lowerAscii :: MonadParser m => m Char +lowerAscii = + satisfy isAsciiLower + "lowercase a-z character" + +asciiAlpha :: MonadParser m => m Char +asciiAlpha = + satisfy isAsciiAlpha + "a-z or A-Z character" + +manyAsciiAlpha :: OrgParser Text +manyAsciiAlpha = + takeWhileP + (Just "a-z or A-Z characters") + isAsciiAlpha + +someAsciiAlpha :: MonadParser m => m Text +someAsciiAlpha = + takeWhile1P + (Just "a-z or A-Z characters") + isAsciiAlpha + +someNonSpace :: OrgParser Text +someNonSpace = takeWhile1P (Just "not whitespace") (not . isSpace) + +isSpaceOrTab :: Char -> Bool +isSpaceOrTab c = c == ' ' || c == '\t' + +spaceOrTab :: OrgParser Char +spaceOrTab = satisfy isSpaceOrTab "space or tab character" + +countSpaces :: Int -> Text -> Int +countSpaces tabWidth = T.foldr go 0 + where + go ' ' = (+ 1) + go '\t' = (+ tabWidth) + go _ = id + +spacesOrTabs :: OrgParser Int +spacesOrTabs = do + tw <- getsO orgSrcTabWidth + countSpaces tw <$> skipSpaces + +spacesOrTabs1 :: OrgParser Int +spacesOrTabs1 = do + tw <- getsO orgSrcTabWidth + countSpaces tw <$> skipSpaces1 + +-- | Skips one or more spaces or tabs. +skipSpaces1 :: MonadParser m => m Text +skipSpaces1 = takeWhile1P (Just "at least one space or tab whitespace") isSpaceOrTab + +-- | Skips zero or more spaces or tabs. +skipSpaces :: MonadParser m => m Text +skipSpaces = takeWhileP (Just "spaces or tabs") isSpaceOrTab + +-- | Makes sure a value is Just, else fail with a custom +-- error message. +guardMaybe :: (MonadFail m, MonadParser m) => String -> Maybe a -> m a +guardMaybe _ (Just x) = pure x +guardMaybe err _ = fail err + +-- | Parse a newline or EOF. Consumes no input at EOF! +newline' :: MonadParser m => m () +newline' = void newline <|> eof + +-- | Parse the rest of line, returning the contents without the final newline. +anyLine :: MonadParser m => m (Tokens Text) +anyLine = + takeWhileP (Just "rest of line") (/= '\n') + <* newline +{-# INLINE anyLine #-} + +-- | Parse the rest of line, returning the contents without the final newline or EOF. +-- Consumes no input at EOF! +anyLine' :: MonadParser m => m (Tokens Text) +anyLine' = + takeWhileP (Just "rest of line") (/= '\n') + <* newline' + +-- | Consumes the rest of input +takeInput :: MonadParser m => m Text +takeInput = takeWhileP Nothing (const True) + +-- | Parse a line with whitespace contents, and consume a newline at the end. +blankline :: MonadParser m => m () +blankline = try $ hspace <* newline + +-- | Parse a line with whitespace contents, line may end with EOF. CAUTION: this +-- function may consume NO INPUT! Be mindful of infinite loops! +blankline' :: MonadParser m => m () +blankline' = try $ hspace <* newline' + +parseFromText :: FullState -> Text -> OrgParser b -> OrgParser b +parseFromText (prevPS, prevOS) txt parser = do + (cPS, cOS) <- getFullState + setFullState + ( prevPS {stateInput = txt}, + -- NOTE: using cOS instead of prevOS + -- is an implementation quirk. We + -- don't want neither the changes of + -- state done by the end parser in + -- markupContext nor the ones in the + -- fromText parser to be lost. But + -- this will have the effect of + -- commuting the change of state: the + -- end changes will be registered + -- before the body ones. This is not a + -- problem because most of state + -- building is commutative and most + -- querying is done in Future anyway. + -- The problematic ones are either + -- irrelevant to a paragraph (like the + -- order in which title keywords are + -- concatenated) or must be handled + -- manually like affiliated keywords. + cOS + { orgStateLastChar = orgStateLastChar prevOS + } + ) + result <- parser + (aPS, aOS) <- getFullState + setFullState + ( cPS + { stateParseErrors = + stateParseErrors cPS + ++ stateParseErrors aPS + }, + aOS + { orgStateLastChar = + orgStateLastChar cOS + } + ) + pure result diff --git a/src/Org/Parser/Definitions.hs b/src/Org/Parser/Definitions.hs new file mode 100644 --- /dev/null +++ b/src/Org/Parser/Definitions.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Org.Parser.Definitions + ( module Org.Parser.Definitions + , module Org.Types + , module Org.Builder + , module Org.Parser.State + , module Text.Megaparsec + , module Text.Megaparsec.Char + , module Text.Megaparsec.Debug + , module Data.Char + ) +where + +import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isPunctuation, isSpace) +import Org.Builder (OrgElements, OrgObjects) +import Org.Parser.State +import Org.Types +import Text.Megaparsec +import Text.Megaparsec.Char +import Text.Megaparsec.Debug +import Prelude hiding (State) + +type Parser = Parsec Void Text + +type MonadParser m = MonadParsec Void Text m + +newtype OrgParser a = OrgParser (ReaderT OrgParserEnv (StateT OrgParserState Parser) a) + deriving newtype + ( Functor + , Applicative + , Monad + , Alternative + , MonadState OrgParserState + , MonadReader OrgParserEnv + , MonadPlus + , MonadFail + , MonadParsec Void Text + ) + +type OrgParseError = ParseErrorBundle Text Void + +-- * Last char + +setLastChar :: Maybe Char -> OrgParser () +setLastChar lchar = + modify (\c -> c {orgStateLastChar = lchar <|> orgStateLastChar c}) + +clearLastChar :: OrgParser () +clearLastChar = modify (\c -> c {orgStateLastChar = Nothing}) + +putLastChar :: Char -> OrgParser () +putLastChar lchar = modify (\c -> c {orgStateLastChar = Just lchar}) + +withIndentLevel :: Int -> OrgParser a -> OrgParser a +withIndentLevel i = local \s -> s {orgEnvIndentLevel = i} + +-- * State and Environment convenience functions + +type FullState = (State Text Void, OrgParserState) + +getFullState :: OrgParser FullState +getFullState = liftA2 (,) getParserState get + +setFullState :: FullState -> OrgParser () +setFullState (pS, oS) = setParserState pS >> put oS + +getsO :: (OrgOptions -> a) -> OrgParser a +getsO f = asks (f . orgEnvOptions) + +-- * Marked parsers + +data Marked m a = Marked + { getMarks :: String + , getParser :: m a + } + +instance Functor m => Functor (Marked m) where + fmap f x@(Marked _ p) = x {getParser = fmap f p} + +instance Alternative m => Semigroup (Marked m a) where + Marked s1 p1 <> Marked s2 p2 = + Marked (s1 ++ s2) (p1 <|> p2) + +instance Alternative m => Monoid (Marked m a) where + mempty = Marked [] empty + mconcat ms = + Marked + (foldMap getMarks ms) + (choice $ map getParser ms) + {-# INLINE mconcat #-} diff --git a/src/Org/Parser/Document.hs b/src/Org/Parser/Document.hs new file mode 100644 --- /dev/null +++ b/src/Org/Parser/Document.hs @@ -0,0 +1,166 @@ +-- | Parsers for Org documents. +module Org.Parser.Document + ( -- Document and sections + orgDocument + , section + + -- * Components + , propertyDrawer + ) where + +import Data.Text qualified as T +import Org.Parser.Common +import Org.Parser.Definitions +import Org.Parser.Elements +import Org.Parser.MarkupContexts +import Org.Parser.Objects +import Prelude hiding (many, some) + +-- | Parse an Org document. +orgDocument :: OrgParser OrgDocument +orgDocument = do + skipMany commentLine + properties <- option mempty propertyDrawer + topLevel <- elements + sections <- many (section 1) + eof + return $ + OrgDocument + { documentProperties = properties + , documentChildren = toList topLevel + , documentSections = sections + } + +{- | Parse an Org section and its contents. @lvl@ gives the minimum acceptable + level of the heading. +-} +section :: Int -> OrgParser OrgSection +section lvl = try $ do + level <- headingStart + guard (lvl <= level) + todoKw <- optional todoKeyword + isComment <- option False $ try $ string "COMMENT" *> hspace1 $> True + priority <- optional priorityCookie + (title, tags, titleTxt) <- titleObjects + planning <- option emptyPlanning planningInfo + properties <- option mempty propertyDrawer + contents <- elements + children <- many (section (level + 1)) + return + OrgSection + { sectionLevel = level + , sectionProperties = properties + , sectionTodo = todoKw + , sectionIsComment = isComment + , sectionPriority = priority + , sectionTitle = toList title + , sectionRawTitle = titleTxt + , sectionAnchor = "" -- Dealt with later + , sectionTags = tags + , sectionPlanning = planning + , sectionChildren = toList contents + , sectionSubsections = children + } + where + titleObjects :: OrgParser (OrgObjects, [Tag], Text) + titleObjects = + option mempty $ + withContext__ + (anySingle *> takeWhileP Nothing (\c -> not (isSpace c || c == ':'))) + endOfTitle + (plainMarkupContext standardSet) + + endOfTitle :: OrgParser [Tag] + endOfTitle = try $ do + hspace + tags <- option [] (headerTags <* hspace) + newline' + return tags + + headerTags :: OrgParser [Tag] + headerTags = try $ do + _ <- char ':' + endBy1 orgTagWord (char ':') + +-- | Parse a to-do keyword that is registered in the state. +todoKeyword :: OrgParser TodoKeyword +todoKeyword = try $ do + taskStates <- getsO orgTodoKeywords + choice (map kwParser taskStates) + where + kwParser :: TodoKeyword -> OrgParser TodoKeyword + kwParser tdm = + -- NOTE to self: space placement - "TO" is subset of "TODOKEY" + try (string (todoName tdm) *> hspace1 $> tdm) + +-- | Parse a priority cookie like @[#A]@. +priorityCookie :: OrgParser Priority +priorityCookie = + try $ + string "[#" + *> priorityFromChar + <* char ']' + where + priorityFromChar :: OrgParser Priority + priorityFromChar = + NumericPriority <$> digitIntChar + <|> LetterPriority <$> upperAscii + +orgTagWord :: OrgParser Text +orgTagWord = + takeWhile1P + (Just "tag characters (alphanumeric, @, %, # or _)") + (\c -> isAlphaNum c || c `elem` ['@', '%', '#', '_']) + +-- | TODO READ ABOUT PLANNING +emptyPlanning :: PlanningInfo +emptyPlanning = PlanningInfo Nothing Nothing Nothing + +-- | Parse a single planning-related and timestamped line. +planningInfo :: OrgParser PlanningInfo +planningInfo = try $ do + updaters <- some planningDatum <* skipSpaces <* newline + return $ foldr ($) emptyPlanning updaters + where + planningDatum = + skipSpaces + *> choice + [ updateWith (\s p -> p {planningScheduled = Just s}) "SCHEDULED" + , updateWith (\d p -> p {planningDeadline = Just d}) "DEADLINE" + , updateWith (\c p -> p {planningClosed = Just c}) "CLOSED" + ] + updateWith fn cs = fn <$> (string cs *> char ':' *> skipSpaces *> parseTimestamp) + +-- | Parse a :PROPERTIES: drawer and return the key/value pairs contained within. +propertyDrawer :: OrgParser Properties +propertyDrawer = try $ do + _ <- skipSpaces + _ <- string' ":properties:" + _ <- skipSpaces + _ <- newline + fromList <$> manyTill nodeProperty (try endOfDrawer) + where + endOfDrawer :: OrgParser Text + endOfDrawer = + try $ + hspace *> string' ":end:" <* blankline' + + nodeProperty :: OrgParser (Text, Text) + nodeProperty = try $ liftA2 (,) name value + + name :: OrgParser Text + name = + skipSpaces + *> char ':' + *> takeWhile1P (Just "node property name") (not . isSpace) + <&> T.stripSuffix ":" + >>= guardMaybe "expecting ':' at end of node property name" + <&> T.toLower + + value :: OrgParser Text + value = + skipSpaces + *> ( takeWhileP (Just "node property value") (/= '\n') + <&> T.stripEnd + ) + <* newline diff --git a/src/Org/Parser/Elements.hs b/src/Org/Parser/Elements.hs new file mode 100644 --- /dev/null +++ b/src/Org/Parser/Elements.hs @@ -0,0 +1,583 @@ +-- | Parsers for Org elements. +module Org.Parser.Elements + ( -- * General + elements + + -- * Greater elements + , plainList + , greaterBlock + , drawer + , footnoteDef + , table + + -- * Lesser elements + , clock + , exampleBlock + , fixedWidth + , srcBlock + , exportBlock + , latexEnvironment + , keyword + , horizontalRule + , commentLine + , commentBlock + ) where + +import Data.Text qualified as T +import Org.Builder qualified as B +import Org.Parser.Common +import Org.Parser.Definitions +import Org.Parser.MarkupContexts +import Org.Parser.Objects +import Relude.Extra hiding (elems, next) +import Replace.Megaparsec +import Prelude hiding (many, some) + +-- * General + +-- | Parse zero or more Org elements. +elements :: OrgParser OrgElements +elements = mconcat <$> many e + where + e = notFollowedBy eof >> elementIndented 0 False + +elementsIndented :: Int -> OrgParser OrgElements +elementsIndented minI = mconcat <$> many e + where + e = do + notFollowedBy (try (blankline' *> blankline') <|> eof) + elementIndented minI False + +{- | Each element parser must consume till the start of a line or EOF. +This is necessary for correct counting of list indentations. +-} +elementIndented :: + Int -> + Bool -> + OrgParser OrgElements +elementIndented minI paraEnd = try (goKws []) + where + goKws kws = do + notFollowedBy headingStart + i <- spacesOrTabs + blank kws <|> do + guard (i >= minI) + optional affiliatedKeyword >>= \case + Just akw -> goKws (akw : kws) <|> return (affToKws (akw : kws)) + Nothing -> withIndentLevel i $ finalize kws + + finalize kws = do + B.element' kws <$> nonParaElement <|> do + guard (not (paraEnd && null kws)) + paraIndented minI kws + + blank kws = do + blankline' $> affToKws kws + + affToKws kws = mconcat (B.element . uncurry B.keyword <$> kws) + + nonParaElement = + choice + [ clock + , commentLine + , exampleBlock + , srcBlock + , exportBlock + , commentBlock + , greaterBlock + , plainList + , latexEnvironment + , drawer + , fixedWidth + , keyword + , horizontalRule + , table + , footnoteDef + ] + +paraIndented :: Int -> [(Text, KeywordValue)] -> OrgParser OrgElements +paraIndented minI kws = + blankline' $> mempty <|> do + (inls, next) <- withContext_ skip end (plainMarkupContext standardSet) + return $ B.element' kws (B.para inls) <> next + where + skip = anySingle >> takeWhileP Nothing (/= '\n') + end :: OrgParser OrgElements + end = + (eof $> mempty) <|> try do + _ <- newline + lookAhead blankline' $> mempty + <|> elementIndented minI True + <|> lookAhead headingStart $> mempty + -- rest of line can't be blank, otherwise elementIndented would succeed + <|> lookAhead (try $ guard . (< minI) =<< spacesOrTabs) $> mempty +{-# INLINEABLE paraIndented #-} + +-- traceWithPos :: String -> OrgParser () +-- traceWithPos m = do +-- s <- getParserState +-- let +-- err :: ParseError Text Void = FancyError (stateOffset s) (one $ ErrorFail m) +-- bundle = ParseErrorBundle (err :| []) (statePosState s) +-- traceM $ errorBundlePretty bundle + +-- * Greater elements + +-- ** Lists + +-- | Parse a plain list. +plainList :: OrgParser OrgElementData +plainList = try do + fstItem <- listItem + rest <- many itemIndented + let kind = listItemType fstItem + items = fstItem : rest + return $ B.list kind items + where + itemIndented = try do + notFollowedBy headingStart + i <- asks orgEnvIndentLevel + j <- spacesOrTabs + guard (j == i) + listItem + +listItem :: OrgParser ListItem +listItem = try do + indent <- asks orgEnvIndentLevel + bullet <- unorderedBullet <|> counterBullet + hspace1 <|> lookAhead newline' + cookie <- optional counterSet + box <- optional checkbox + -- for the tag, previous horizontal space must have been consumed + tag <- case bullet of + Bullet _ -> option [] (toList <$> itemTag) + _ -> return [] + els <- liftA2 (<>) (paraIndented (indent + 1) []) (elementsIndented (indent + 1)) + return (ListItem bullet cookie box tag (toList els)) + where + unorderedBullet = try $ Bullet <$> satisfy \c -> c == '+' || c == '-' || c == '*' + counterBullet = try do + counter <- digits1 <|> T.singleton <$> satisfy isAsciiAlpha + d <- satisfy \c -> c == '.' || c == ')' + pure (Counter counter d) + +counterSet :: OrgParser Int +counterSet = + try $ + string "[@" + *> parseNum + <* char ']' + <* hspace + where + parseNum = integer <|> asciiAlpha' + +checkbox :: OrgParser Checkbox +checkbox = + try $ + char '[' + *> tick + <* char ']' + <* (hspace1 <|> lookAhead newline') + where + tick = + char ' ' $> BoolBox False + <|> char 'X' $> BoolBox True + <|> char '-' $> PartialBox + +itemTag :: OrgParser OrgObjects +itemTag = withMContext (/= '\n') (not . isSpace) end (plainMarkupContext standardSet) + where + end = try do + hspace1 + _ <- string "::" + hspace1 <|> lookAhead newline' + +-- ** Greater blocks + +-- | Parse a greater block. +greaterBlock :: OrgParser OrgElementData +greaterBlock = try do + _ <- string'' "#+begin_" + bname <- someNonSpace <* anyLine + els <- withContext anyLine (end bname) elements + return $ B.greaterBlock (blockType bname) els + where + blockType = \case + (T.toLower -> "center") -> Center + (T.toLower -> "quote") -> Quote + other -> Special other + end :: Text -> OrgParser Text + end name = try $ hspace *> string'' "#+end_" *> string'' name <* blankline' + +-- verseBlock :: OrgParser OrgElements +-- verseBlock = try do +-- hspace +-- _ <- string'' "#+begin_verse" +-- undefined +-- where +-- end = try $ hspace *> string'' "#+end_export" <* blankline' + +-- ** Drawers + +-- | Parse a drawer. +drawer :: OrgParser OrgElementData +drawer = try do + _ <- char ':' + dname <- takeWhile1P (Just "drawer name") (\c -> c /= ':' && c /= '\n') + char ':' >> blankline + els <- withContext anyLine end elements + return $ B.drawer dname els + where + end :: OrgParser () + end = try $ hspace <* string'' ":end:" <* blankline' + +-- ** Footnote definitions + +-- | Parse a footnote definition. +footnoteDef :: OrgParser OrgElementData +footnoteDef = try do + guard . (== 0) =<< asks orgEnvIndentLevel + lbl <- start + _ <- optional blankline' + def <- + withContext + anyLine + ( lookAhead $ + void headingStart + <|> try (blankline' *> blankline') + <|> void (try start) + ) + elements + return $ B.footnoteDef lbl def + where + start = + string "[fn:" + *> takeWhile1P + (Just "footnote def label") + (\c -> isAlphaNum c || c == '-' || c == '_') + <* char ']' + +-- ** Tables + +-- | Parse a table. +table :: OrgParser OrgElementData +table = try do + _ <- lookAhead $ char '|' + rows <- some tableRow + return $ B.table rows + where + tableRow :: OrgParser TableRow + tableRow = ruleRow <|> columnPropRow <|> standardRow + + ruleRow = try $ RuleRow <$ (hspace >> string "|-" >> anyLine') + + columnPropRow = try do + hspace + _ <- char '|' + ColumnPropsRow + <$> some cell + <* blankline' + where + cell = do + hspace + Just <$> cookie <|> Nothing <$ void (char '|') + cookie = try do + a <- + string " AlignLeft + <|> string " AlignCenter + <|> string " AlignRight + _ <- digits + _ <- char '>' + hspace + void (char '|') <|> lookAhead newline' + pure a + + standardRow = try do + hspace + _ <- char '|' + B.standardRow + <$> some cell + <* blankline' + where + cell = do + hspace + char '|' $> mempty + <|> withMContext + (const True) + (\c -> not $ isSpace c || c == '|') + end + (plainMarkupContext standardSet) + end = try $ hspace >> void (char '|') <|> lookAhead newline' + +-- * Lesser elements + +-- ** Code + +-- | Parse an example block. +exampleBlock :: OrgParser OrgElementData +exampleBlock = try do + _ <- string'' "#+begin_example" + switches <- blockSwitches + _ <- anyLine + contents <- rawBlockContents end switches + pure $ B.example switches contents + where + end = try $ hspace *> string'' "#+end_example" <* blankline' + +-- | Parse a fixed width block. +fixedWidth :: OrgParser OrgElementData +fixedWidth = try do + contents <- SrcLine <<$>> some (hspace *> string ": " *> anyLine') + tabWidth <- getsO orgSrcTabWidth + preserveIndent <- getsO orgSrcPreserveIndentation + let lines' = + if preserveIndent + then map (srcLineMap (tabsToSpaces tabWidth)) contents + else indentContents tabWidth contents + pure $ B.example mempty lines' + +-- | Parse a source block. +srcBlock :: OrgParser OrgElementData +srcBlock = try do + _ <- string'' "#+begin_src" + lang <- option "" $ hspace1 *> someNonSpace + switches <- blockSwitches + args <- headerArgs + contents <- rawBlockContents end switches + pure $ B.srcBlock lang switches args contents + where + end = try $ hspace *> string'' "#+end_src" <* blankline' + +headerArgs :: OrgParser [(Text, Text)] +headerArgs = do + hspace + fromList + <$> headerArg + `sepBy` hspace1 + <* anyLine' + where + headerArg = + liftA2 + (,) + (char ':' *> someNonSpace) + ( T.strip . fst + <$> findSkipping + (not . isSpace) + ( try $ + lookAhead + ( newline' + <|> hspace1 <* char ':' + ) + ) + ) + +-- | Parse an export block. +exportBlock :: OrgParser OrgElementData +exportBlock = try do + _ <- string'' "#+begin_export" + format <- option "" $ hspace1 *> someNonSpace + _ <- anyLine + contents <- T.unlines <$> manyTill anyLine end + return $ B.export format contents + where + end = try $ hspace *> string'' "#+end_export" <* blankline' + +indentContents :: Int -> [SrcLine] -> [SrcLine] +indentContents tabWidth (map (srcLineMap $ tabsToSpaces tabWidth) -> lins) = + map (srcLineMap $ T.drop minIndent) lins + where + minIndent = maybe 0 minimum1 (nonEmpty $ map (indentSize . srcLineContent) lins) + indentSize = T.length . T.takeWhile (== ' ') + +tabsToSpaces :: Int -> Text -> Text +tabsToSpaces tabWidth txt = + T.span (\c -> c == ' ' || c == '\t') txt + & first + ( flip T.replicate " " + . uncurry (+) + . bimap T.length ((* tabWidth) . T.length) + . T.partition (== ' ') + ) + & uncurry (<>) + +rawBlockContents :: OrgParser void -> Map Text Text -> OrgParser [SrcLine] +rawBlockContents end switches = do + contents <- manyTill (rawBlockLine switches) end + tabWidth <- getsO orgSrcTabWidth + preserveIndent <- getsO orgSrcPreserveIndentation + pure $ + if preserveIndent || "-i" `member` switches + then map (srcLineMap (tabsToSpaces tabWidth)) contents + else indentContents tabWidth contents + +quotedLine :: OrgParser Text +quotedLine = do + (<>) + <$> option "" (try $ char ',' *> (string "*" <|> string "#+")) + <*> anyLine + +rawBlockLine :: Map Text Text -> OrgParser SrcLine +rawBlockLine switches = + try $ applyRef =<< quotedLine + where + (refpre, refpos) = + maybe + ("(ref:", ")") + (second (T.drop 2) . T.breakOn "%s") + $ lookup "-l" switches + applyRef txt + | Just (content, ref, _) <- breakCap refCookie txt = + pure $ RefLine "" ref content + | otherwise = pure $ SrcLine txt + refCookie :: Parser Text + refCookie = do + space1 <* string refpre + toText + <$> someTill + (satisfy $ \c -> isAsciiAlpha c || isDigit c || c == '-' || c == ' ') + (string refpos) + +blockSwitches :: OrgParser (Map Text Text) +blockSwitches = fromList <$> many (linum <|> switch <|> fmt) + where + linum :: OrgParser (Text, Text) + linum = try $ do + hspace1 + s <- + T.snoc . one + <$> oneOf ['+', '-'] + <*> char 'n' + num <- option "" $ try $ hspace1 *> takeWhileP Nothing isDigit + _ <- lookAhead spaceChar + return (s, num) + + fmt :: OrgParser (Text, Text) + fmt = try $ do + hspace1 + s <- string "-l" + hspace1 + str <- + between (char '"') (char '"') $ + takeWhileP Nothing (\c -> c /= '"' && c /= '\n') + _ <- lookAhead spaceChar + return (s, str) + + switch :: OrgParser (Text, Text) + switch = try $ do + hspace1 + s <- + T.snoc . one + <$> char '-' + <*> oneOf ['i', 'k', 'r'] + _ <- lookAhead spaceChar + pure (s, "") + +-- ** LaTeX + +-- | Parse a LaTeX environment. +latexEnvironment :: OrgParser OrgElementData +latexEnvironment = try do + _ <- string "\\begin{" + ename <- + takeWhile1P + (Just "latex environment name") + (\c -> isAsciiAlpha c || isDigit c || c == '*') + _ <- char '}' + (str, _) <- findSkipping (/= '\\') (end ename) + return $ B.latexEnvironment ename $ "\\begin{" <> ename <> "}" <> str <> "\\end{" <> ename <> "}" + where + end :: Text -> OrgParser () + end name = try $ string ("\\end{" <> name <> "}") *> blankline' + +-- ** Keywords + +affiliatedKeyword :: OrgParser (Text, KeywordValue) +affiliatedKeyword = try do + v <- keywordData + let name = fst v + unless ("attr_" `T.isPrefixOf` name) do + akws <- getsO orgElementAffiliatedKeywords + guard $ name `member` akws + return v + +-- | Parse a keyword. +keyword :: OrgParser OrgElementData +keyword = uncurry B.keyword <$> keywordData + +keywordData :: OrgParser (Text, KeywordValue) +keywordData = try do + _ <- string "#+" + -- This is one of the places where it is convoluted to replicate org-element + -- regexes: "#+abc:d:e :f" is a valid keyword of key "abc:d" and value "e :f". + name <- + T.toLower . fst <$> fix \me -> do + res@(name, _) <- + skipManyTill' (satisfy (not . isSpace)) $ + try $ + char ':' *> notFollowedBy me + guard (not $ T.null name) + pure res + hspace + if "attr_" `T.isPrefixOf` name + then do + args <- B.attrKeyword <$> headerArgs + return (name, args) + else do + text <- T.stripEnd <$> anyLine' + parsedKws <- getsO orgElementParsedKeywords + value <- + if name `member` parsedKws + then do + st <- getFullState + ParsedKeyword . toList + <$> parseFromText st text (plainMarkupContext standardSet) + else return $ ValueKeyword text + return (name, value) + +-- ** Horizontal Rules + +-- | Parse a horizontal rule. +horizontalRule :: OrgParser OrgElementData +horizontalRule = try do + l <- T.length <$> takeWhile1P (Just "hrule dashes") (== '-') + guard (l >= 5) + blankline' + return B.horizontalRule + +-- ** Comments + +-- | Parse a comment. +commentLine :: OrgParser OrgElementData +commentLine = try do + _ <- char '#' + blankline' <|> (char ' ' <|> fail "If this was meant as a comment, a space is missing here.") *> void anyLine' + pure Comment + +-- | Parse a comment block. +commentBlock :: OrgParser OrgElementData +commentBlock = try do + _ <- string'' "#+begin_comment" + _ <- anyLine + _ <- skipManyTill anyLine end + pure Comment + where + end = try $ hspace *> string'' "#+end_comment" <* blankline' + +clock :: OrgParser OrgElementData +clock = try do + _ <- string'' "clock: " + ts <- parseTimestamp + case ts of + TimestampData False _ -> do + blankline' + return $ B.clock ts Nothing + TimestampRange False _ _ -> do + t <- optional $ do + _ <- try $ do + hspace1 + string "=>" + hspace1 + parseTime + blankline' + return $ B.clock ts t + _ -> fail "Clock timestamp must be inactive." diff --git a/src/Org/Parser/MarkupContexts.hs b/src/Org/Parser/MarkupContexts.hs new file mode 100644 --- /dev/null +++ b/src/Org/Parser/MarkupContexts.hs @@ -0,0 +1,149 @@ +{- | This module used to define a "subparsing" monad but this was later +absorbed into OrgState. Maybe I should move its contents elsewhere. +-} +module Org.Parser.MarkupContexts where + +import Data.Set (notMember) +import Data.Text qualified as T +import Org.Parser.Common +import Org.Parser.Definitions + +skipManyTill' :: + forall skip end m. + MonadParser m => + m skip -> + m end -> + m (Text, end) +skipManyTill' skip end = try $ do + o0 <- getOffset + s0 <- getInput + -- note: skipManyTill tries end parser first + (o1, final) <- skipManyTill skip (liftA2 (,) getOffset end) + pure (T.take (o1 - o0) s0, final) +{-# INLINEABLE skipManyTill' #-} + +findSkipping :: + forall end. + (Char -> Bool) -> + OrgParser end -> + OrgParser (Text, end) +findSkipping skip = skipManyTill' toSkip + where + toSkip = anySingle *> takeWhileP Nothing skip +{-# INLINEABLE findSkipping #-} + +withContext__ :: + forall a end skip. + OrgParser skip -> + OrgParser end -> + OrgParser a -> + OrgParser (a, end, Text) +withContext__ skip end p = try do + clearLastChar + st <- getFullState + (str, final) <- skipManyTill' skip end + guard (not $ T.null str) + (,final,str) <$> parseFromText st str p +{-# INLINEABLE withContext__ #-} + +withContext_ :: + forall a end skip. + OrgParser skip -> + OrgParser end -> + OrgParser a -> + OrgParser (a, end) +withContext_ skip end p = + withContext__ skip end p <&> \(x, y, _) -> (x, y) +{-# INLINEABLE withContext_ #-} + +withContext :: + forall a end skip. + OrgParser skip -> + OrgParser end -> + OrgParser a -> + OrgParser a +withContext skip end = fmap fst . withContext_ skip end +{-# INLINEABLE withContext #-} + +withMContext :: + forall a b. + (Char -> Bool) -> + (Char -> Bool) -> + OrgParser b -> + OrgParser a -> + OrgParser a +withMContext allowed skip end p = try do + clearLastChar + st <- getFullState + prelim <- takeWhileP Nothing \c -> skip c && allowed c + ((prelim <>) -> str, _) <- skipManyTill' toSkip end + guard (not $ T.null str) + parseFromText st str p + where + toSkip = satisfy allowed *> takeWhileP Nothing \c -> skip c && allowed c +{-# INLINEABLE withMContext #-} + +withBalancedContext :: + Char -> + Char -> + -- | Allowed + (Char -> Bool) -> + OrgParser a -> + OrgParser a +withBalancedContext lchar rchar allowed p = try do + _ <- char lchar + let skip :: StateT Int OrgParser () + skip = do + _ <- + takeWhileP + (Just "insides of markup") + (\c -> allowed c && c /= lchar && c /= rchar) + c <- lookAhead (satisfy allowed) "balanced delimiters" + when (c == lchar) $ modify (+ 1) + when (c == rchar) $ modify (subtract 1) + get >>= \case + balance + | balance < 0 -> fail "unbalaced delimiters" + | balance == 0 -> pure () + | otherwise -> void anySingle + end = try do + guard . (== 0) =<< get + _ <- char rchar + lift $ putLastChar rchar + st <- getFullState + (str, _) <- evalStateT (skipManyTill' skip end) 1 + parseFromText st str p + +{- | Parse inside a "context": text that is not captured by the parser `elems` + gets converted to the type `k` via the function `f`. +-} +markupContext :: + Monoid k => + (Text -> k) -> + Marked OrgParser k -> + OrgParser k +markupContext f elems = go + where + go = try $ do + let specials :: Set Char = fromList $ getMarks elems + str <- + optional $ + takeWhile1P + Nothing + (`notMember` specials) + -- traceM $ "consumed: " ++ show str + let self = maybe mempty f str + setLastChar (T.last <$> str) + (self <>) <$> (finishSelf <|> anotherEl <|> nextChar) + where + finishSelf = eof $> mempty + anotherEl = try $ do + el <- getParser elems + rest <- go + pure $ el <> rest + nextChar = try $ do + c <- anySingle + -- traceM $ "parsed char: " ++ show c + putLastChar c + rest <- go + pure $ f (one c) <> rest diff --git a/src/Org/Parser/Objects.hs b/src/Org/Parser/Objects.hs new file mode 100644 --- /dev/null +++ b/src/Org/Parser/Objects.hs @@ -0,0 +1,649 @@ +-- | Parsers for Org objects. +module Org.Parser.Objects + ( -- * Sets of markup + minimalSet + , standardSet + + -- * Marked parsers + , Marked (..) + , markupContext + , plainMarkupContext + + -- * General purpose parsers + , markup + , rawMarkup + + -- * Objects + , code + , verbatim + , italic + , underline + , bold + , strikethrough + , singleQuoted + , doubleQuoted + , entity + , latexFragment + , texMathFragment + , exportSnippet + , citation + , inlBabel + , inlSrc + , linebreak + , angleLink + , regularLink + , target + , suscript + , macro + , footnoteReference + , timestamp + , statisticCookie + + -- * Auxiliary + , linkToTarget + , parseTimestamp + ) +where + +import Data.Set qualified as Set +import Data.Text qualified as T +import Org.Builder qualified as B +import Org.Data.Entities (defaultEntitiesNames) +import Org.Parser.Common +import Org.Parser.Definitions +import Org.Parser.MarkupContexts +import Prelude hiding (many, some) + +-- * Sets of objects + +minimalSet :: Marked OrgParser OrgObjects +minimalSet = + mconcat + [ endline + , code + , verbatim + , italic + , underline + , bold + , strikethrough + , entity + , latexFragment + , texMathFragment + , singleQuoted + , doubleQuoted + , suscript + , statisticCookie + , macro + ] + +standardSet :: Marked OrgParser OrgObjects +standardSet = + mconcat + [ minimalSet + , regularLink + , footnoteReference + , timestamp + , exportSnippet + , inlBabel + , inlSrc + , linebreak + , target + , angleLink + , citation + ] + +{- | Parse inside a "plain context", i.e., plain text not matched by any parsers + gets converted to 'Plain' objects. + +@ +'plainMarkupContext' = 'markupContext' 'B.plain' +@ +-} +plainMarkupContext :: Marked OrgParser OrgObjects -> OrgParser OrgObjects +plainMarkupContext = markupContext B.plain + +newlineAndClear :: OrgParser Char +newlineAndClear = newline <* clearLastChar + +emphasisPreChars :: Set Char +emphasisPreChars = fromList "-('\"{" + +emphPreChar :: Char -> Bool +emphPreChar c = isSpace c || c `Set.member` emphasisPreChars + +emphasisPre :: Char -> OrgParser () +emphasisPre s = try $ do + lchar <- gets orgStateLastChar + for_ lchar $ guard . emphPreChar + _ <- char s + notFollowedBy spaceChar + +emphasisPostChars :: Set Char +emphasisPostChars = fromList "-.,;:!?'\")}\\[" + +emphPostChar :: Char -> Bool +emphPostChar c = isSpace c || c `Set.member` emphasisPostChars + +emphasisPost :: Char -> OrgParser () +emphasisPost e = try $ do + lchar <- gets orgStateLastChar + for_ lchar $ guard . not . isSpace + _ <- char e + putLastChar e + lookAhead (eof <|> void (satisfy emphPostChar)) + +emphasisSkip :: Char -> OrgParser () +emphasisSkip s = try $ do + putLastChar =<< anySingle + t <- takeWhileP Nothing (/= s) + setLastChar (snd <$> T.unsnoc t) + +markup :: + (OrgObjects -> OrgObjects) -> + Char -> + Marked OrgParser OrgObjects +markup f c = Marked [c] $ + try $ do + emphasisPre c + st <- getFullState + s <- anySingle + (t, _) <- skipManyTill' (emphasisSkip c) (emphasisPost c) + f <$> parseFromText st (T.cons s t) (plainMarkupContext standardSet) + +rawMarkup :: + (Text -> OrgObjects) -> + Char -> + Marked OrgParser OrgObjects +rawMarkup f d = Marked [d] $ + try $ do + emphasisPre d + f . fst <$> skipManyTill' (emphasisSkip d) (emphasisPost d) + +-- | Parse a code object. +code :: Marked OrgParser OrgObjects +code = rawMarkup B.code '~' + +-- | Parse a verbatim object. +verbatim :: Marked OrgParser OrgObjects +verbatim = rawMarkup B.verbatim '=' + +-- | Parse an italic object. +italic :: Marked OrgParser OrgObjects +italic = markup B.italic '/' + +-- | Parse an underline object. +underline :: Marked OrgParser OrgObjects +underline = markup B.underline '_' + +-- | Parse a bold object. +bold :: Marked OrgParser OrgObjects +bold = markup B.bold '*' + +-- | Parse a strikethrough object. +strikethrough :: Marked OrgParser OrgObjects +strikethrough = markup B.strikethrough '+' + +-- | Parse a single-quoted object. +singleQuoted :: Marked OrgParser OrgObjects +singleQuoted = markup B.singleQuoted '\'' + +-- | Parse a double-quoted object. +doubleQuoted :: Marked OrgParser OrgObjects +doubleQuoted = markup B.doubleQuoted '"' + +-- | An endline character that can be treated as a space, not a line break. +endline :: Marked OrgParser OrgObjects +endline = + Marked "\n" $ + try $ + newlineAndClear + *> hspace + $> B.plain "\n" + +-- * Entities and LaTeX fragments + +-- | Parse an entity object. +entity :: Marked OrgParser OrgObjects +entity = Marked "\\" $ try $ do + _ <- char '\\' + name <- choice (map string defaultEntitiesNames) + void (string "{}") <|> notFollowedBy asciiAlpha + pure $ B.entity name + +-- | Parse a LaTeX fragment object. +latexFragment :: Marked OrgParser OrgObjects +latexFragment = Marked "\\" $ try do + _ <- char '\\' + mathFragment <|> rawFragment + where + mathFragment = try do + inline <- + char '(' $> True + <|> char '[' $> False + (str, _) <- + findSkipping + (/= '\\') + (try $ char '\\' *> char if inline then ')' else ']') + pure $ + if inline + then B.inlMath str + else B.dispMath str + + rawFragment :: MonadParser m => m OrgObjects + rawFragment = try $ do + name <- someAsciiAlpha + text <- (name <>) <$> option "" brackets + pure $ B.fragment ("\\" <> text) + + brackets :: MonadParser m => m Text + brackets = try $ do + open <- satisfy (\c -> c == '{' || c == '[') + let close = if open == '{' then '}' else ']' + str <- takeWhileP Nothing (\c -> c /= close && c /= '\n') + _ <- char close + pure $ open `T.cons` str `T.snoc` close + +-- | Parse a TeX math fragment object. +texMathFragment :: Marked OrgParser OrgObjects +texMathFragment = Marked "$" $ try $ display <|> inline + where + display = try $ do + _ <- string "$$" + (str, _) <- + findSkipping + (/= '$') + (string "$$") + pure $ B.dispMath str + + post = do + _ <- char '$' + eof + <|> ( void . lookAhead $ + satisfy (\x -> isPunctuation x || isSpace x || x == '"') + ) + + inline = try $ do + lchar <- gets orgStateLastChar + for_ lchar $ guard . (/= '$') + _ <- char '$' + str <- singleChar <|> moreChars + pure $ B.inlMath str + + moreChars = try $ do + str <- takeWhile1P (Just "inside of inline math") (/= '$') + guard $ border1 (T.head str) && border2 (T.last str) + post + pure str + + singleChar = try $ do + c <- satisfy (\x -> not (isSpace x) && x `notElem` disallowedCharsSet) + post + pure $ one c + + disallowedCharsSet :: [Char] + disallowedCharsSet = ['.', ',', '?', ';', '"'] + + border1 c = not (isSpace c) && c `notElem` (".,;$" :: String) + border2 c = not (isSpace c) && c `notElem` (".,$" :: String) + +-- * Export snippets + +-- | Parse an export snippet object. +exportSnippet :: Marked OrgParser OrgObjects +exportSnippet = Marked "@" $ + try $ do + _ <- string "@@" + backend <- + takeWhile1P + (Just "export snippet backend") + (\c -> isAsciiAlpha c || isDigit c || c == '-') + _ <- char ':' + B.exportSnippet backend . fst + <$> findSkipping (/= '@') (string "@@") + +-- * Citations + +-- The following code for org-cite citations was adapted and improved upon pandoc's. + +-- | Parse a citation object. +citation :: Marked OrgParser OrgObjects +citation = + Marked "[" $ + B.citation <$> withBalancedContext '[' ']' (const True) orgCite + +-- | A citation in org-cite style +orgCite :: OrgParser Citation +orgCite = try $ do + _ <- string "cite" + (style, variant) <- citeStyle + _ <- char ':' + space + globalPrefix <- option mempty (try (citeSuffix <* char ';')) + items <- citeItems + globalSuffix <- option mempty (try (char ';' *> citePrefix)) + space + eof + return + Citation + { citationStyle = style + , citationVariant = variant + , citationPrefix = toList globalPrefix + , citationSuffix = toList globalSuffix + , citationReferences = items + } + +citeStyle :: OrgParser (Tokens Text, Tokens Text) +citeStyle = do + sty <- option "" $ try style + vars <- option "" $ try variants + return (sty, vars) + where + style = + char '/' + *> takeWhileP + (Just "alphaNum, '_' or '-' characters") + (\c -> isAlphaNum c || c == '_' || c == '-') + variants = + char '/' + *> takeWhileP + (Just "alphaNum, '_', '-' or '/' characters") + (\c -> isAlphaNum c || c == '_' || c == '-' || c == '/') + +citeItems :: OrgParser [CiteReference] +citeItems = citeItem `sepBy1'` char ';' + where + sepBy1' p sep = (:) <$> p <*> many (try $ sep >> p) + +citeItem :: OrgParser CiteReference +citeItem = do + pref <- option mempty citePrefix + itemKey <- orgCiteKey + suff <- option mempty citeSuffix + return + CiteReference + { refId = itemKey + , refPrefix = toList pref + , refSuffix = toList suff + } + +citePrefix :: OrgParser OrgObjects +citePrefix = try $ do + clearLastChar + withContext + (takeWhile1P Nothing (/= '@')) + (eof <|> void (lookAhead $ char '@')) + (plainMarkupContext minimalSet) + +citeSuffix :: OrgParser OrgObjects +citeSuffix = try $ do + clearLastChar + withContext + (takeWhile1P Nothing (/= ';')) + (eof <|> void (lookAhead $ char ';')) + (plainMarkupContext minimalSet) + +orgCiteKey :: OrgParser Text +orgCiteKey = do + _ <- char '@' + takeWhile1P (Just "citation key allowed chars") orgCiteKeyChar + +orgCiteKeyChar :: Char -> Bool +orgCiteKeyChar c = + isAlphaNum c || c `elem` (".:?!`\'/*@+|(){}<>&_^$#%~-" :: String) + +-- * Inline Babel calls + +-- | Parse an inline babel call object. +inlBabel :: Marked OrgParser OrgObjects +inlBabel = Marked "c" . try $ do + _ <- string "call_" + name <- + takeWhile1P + (Just "babel call name") + (\c -> not (isSpace c) && c `notElem` ['[', ']', '(', ')']) + header1 <- option "" header + args <- arguments + header2 <- option "" header + return $ B.inlBabel name header1 header2 args + where + header = withBalancedContext '[' ']' (/= '\n') getInput + arguments = withBalancedContext '(' ')' (/= '\n') getInput + +-- * Inline source blocks + +-- | Parse an inline source object. +inlSrc :: Marked OrgParser OrgObjects +inlSrc = Marked "s" . try $ do + _ <- string "src_" + name <- + takeWhile1P + (Just "babel call name") + (\c -> not (isSpace c) && c /= '{' && c /= '[') + headers <- option "" header + B.inlSrc name headers <$> body + where + header = withBalancedContext '[' ']' (/= '\n') getInput + body = withBalancedContext '{' '}' (/= '\n') getInput + +-- * Line breaks + +-- | Parse a linebreak object. +linebreak :: Marked OrgParser OrgObjects +linebreak = + Marked "\\" . try $ + B.linebreak <$ string "\\\\" <* blankline' <* clearLastChar + +-- * Links + +-- | Parse a angle link object. +angleLink :: Marked OrgParser OrgObjects +angleLink = Marked "<" . try $ do + _ <- char '<' + protocol <- manyAsciiAlpha + _ <- char ':' + tgt <- fix $ \search -> do + partial <- + takeWhile1P + (Just "angle link target") + (\c -> c /= '\n' && c /= '>') + char '>' $> partial + <|> newline *> hspace *> ((T.stripEnd partial <>) <$> search) + return $ B.uriLink protocol tgt (B.plain $ protocol <> ":" <> tgt) + +-- | Parse a regular link object. +regularLink :: Marked OrgParser OrgObjects +regularLink = + Marked "[" . try $ + do + _ <- string "[[" + str <- linkTarget + descr <- linkDescr <|> char ']' $> mempty + putLastChar ']' + return $ B.link (linkToTarget str) descr + where + linkTarget :: MonadParser m => m Text + linkTarget = fix $ \rest -> do + partial <- + takeWhileP + (Just "link target") + (\c -> c /= ']' && c /= '[' && c /= '\\' && c /= '\n') + oneOf ['[', ']'] $> partial + <|> char '\\' *> liftA2 T.cons (option '\\' $ oneOf ['[', ']']) rest + <|> newline *> hspace *> ((T.stripEnd partial `T.snoc` ' ' <>) <$> rest) + + linkDescr :: OrgParser OrgObjects + linkDescr = try $ do + _ <- char '[' + -- FIXME this is not the right set but... whatever + withContext skip (string "]]") (plainMarkupContext standardSet) + where + skip = anySingle >> takeWhileP Nothing (/= ']') + +-- TODO this will probably be replaced by the AST annotations. + +-- | Transform the link text into a link target. +linkToTarget :: Text -> LinkTarget +linkToTarget link + | any (`T.isPrefixOf` link) ["/", "./", "../"] = + let link' = toText (toString link) + in URILink "file" link' + | (prot, rest) <- T.break (== ':') link + , Just (_, uri) <- T.uncons rest = + URILink prot uri + | otherwise = UnresolvedLink link + +-- * Targets and radio targets + +-- | Parse a target object. +target :: Marked OrgParser OrgObjects +target = Marked "<" $ try do + _ <- string "<<" + str <- takeWhile1P (Just "dedicated target") (\c -> c /= '<' && c /= '>' && c /= '\n') + guard (not (isSpace $ T.head str)) + guard (not (isSpace $ T.last str)) + _ <- string ">>" + return $ B.target "" str + +-- * Subscripts and superscripts + +-- | Parse a subscript or a superscript object. +suscript :: Marked OrgParser OrgObjects +suscript = Marked "_^" $ try do + lchar <- gets orgStateLastChar + for_ lchar $ guard . not . isSpace + start <- satisfy \c -> c == '_' || c == '^' + contents <- asterisk <|> balanced <|> plain + pure $ + if start == '_' + then B.subscript contents + else B.superscript contents + where + asterisk = B.plain . one <$> char '*' + + balanced = + withBalancedContext '{' '}' (const True) $ + plainMarkupContext minimalSet + + sign = option mempty (B.plain . one <$> oneOf ['+', '-']) + + plain = + liftA2 (<>) sign $ + withMContext (const True) isAlphaNum plainEnd $ + plainMarkupContext (entity <> latexFragment) + + plainEnd :: OrgParser () + plainEnd = try do + lookAhead $ + eof + <|> try (some (oneOf [',', '.', '\\']) *> notFollowedBy (satisfy isAlphaNum)) + <|> void (noneOf [',', '.', '\\']) + +-- * Macros + +-- | Parse a macro object. +macro :: Marked OrgParser OrgObjects +macro = Marked "{" $ try do + _ <- string "{{{" + _ <- lookAhead $ satisfy isAsciiAlpha + key <- takeWhile1P Nothing allowedKeyChar + args <- + (string "}}}" $> []) <|> do + _ <- char '(' + t <- fst <$> findSkipping (/= ')') (string ")}}}") + return $ T.split (== ',') t + return $ B.macro key args + where + allowedKeyChar c = isAsciiAlpha c || isDigit c || c == '-' || c == '_' + +-- * Footnote references + +-- | Parse a footnote reference object. +footnoteReference :: Marked OrgParser OrgObjects +footnoteReference = Marked "[" $ + withBalancedContext '[' ']' (const True) do + _ <- string "fn:" + lbl <- + optional $ + takeWhile1P + (Just "footnote ref label") + (\c -> isAlphaNum c || c == '-' || c == '_') + def <- + optional $ try do + _ <- char ':' + plainMarkupContext standardSet + case (lbl, def) of + (Nothing, Nothing) -> empty + (Just lbl', Nothing) -> + return $ B.footnoteLabel lbl' + (_, Just def') -> + return $ B.footnoteInlDef lbl def' + +-- * Timestamps + +-- | Parse a timestamp object. +timestamp :: Marked OrgParser OrgObjects +timestamp = Marked "<[" $ B.timestamp <$> parseTimestamp + +-- | Parse a timestamp. +parseTimestamp :: OrgParser TimestampData +parseTimestamp = try $ do + openChar <- lookAhead $ satisfy (\c -> c == '<' || c == '[') + let isActive = openChar == '<' + closeChar = if isActive then '>' else ']' + delims = (openChar, closeChar) + (d1, t1, r1, w1) <- component delims + optional (try $ string "--" *> component delims) + >>= \case + Just (d2, t2, r2, w2) -> + pure $ TimestampRange isActive (d1, fst <$> t1, r1, w1) (d2, fst <$> t2, r2, w2) + Nothing -> case t1 of + Just (t1', Just t1'') -> + pure $ TimestampRange isActive (d1, Just t1', r1, w1) (d1, Just t1'', r1, w1) + _ -> + pure $ TimestampData isActive (d1, fst <$> t1, r1, w1) + where + component delims = do + _ <- char (fst delims) + date <- parseDate + time <- optional . try $ do + hspace1 + startTime <- parseTime + endTime <- optional . try $ char '-' *> parseTime + pure (startTime, endTime) + repeater <- optional (try $ hspace1 *> repeaterMark) + warning <- optional (try $ hspace1 *> warningMark) + hspace + _ <- char (snd delims) + pure (date, time, repeater, warning) + + parseDate :: OrgParser Date + parseDate = do + year <- number 4 <* char '-' + month <- number 2 <* char '-' + day <- number 2 + dayName <- optional $ try do + hspace1 + takeWhile1P (Just "dayname characters") isLetter + pure (year, month, day, dayName) + + repeaterMark = tsmark ["++", ".+", "+"] + + warningMark = tsmark ["--", "-"] + + tsmark :: [Text] -> OrgParser TimestampMark + tsmark marks = do + mtype <- (,,) <$> choice (map string marks) + mtype <$> integer <*> oneOf ['h', 'd', 'w', 'm', 'y'] + +-- * Statistic Cookies + +-- | Parse a statistic cookie object. +statisticCookie :: Marked OrgParser OrgObjects +statisticCookie = Marked "[" $ try do + _ <- char '[' + res <- Left <$> fra <|> Right <$> pct + _ <- char ']' + return $ B.statisticCookie res + where + fra = try $ liftA2 (,) integer (char '/' *> integer) + pct = try $ integer <* char '%' diff --git a/src/Org/Parser/State.hs b/src/Org/Parser/State.hs new file mode 100644 --- /dev/null +++ b/src/Org/Parser/State.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedLists #-} + +module Org.Parser.State where + +import Data.Aeson qualified as Aeson +import Org.Types + +-- | Collection of todo markers in the order in which items should progress +type TodoSequence = [TodoKeyword] + +data OrgOptions = OrgOptions + { orgSrcPreserveIndentation :: Bool + , orgSrcTabWidth :: Int + , orgTodoKeywords :: TodoSequence + , orgElementParsedKeywords :: Set Text + , orgElementDualKeywords :: Set Text + , orgElementAffiliatedKeywords :: Set Text + } + deriving (Eq, Ord, Show, Typeable, Generic) + +instance Aeson.ToJSON OrgOptions where + toJSON = Aeson.genericToJSON aesonOptions + toEncoding = Aeson.genericToEncoding aesonOptions + +instance Aeson.FromJSON OrgOptions where + parseJSON = Aeson.genericParseJSON aesonOptions + +instance NFData OrgOptions + +defaultOrgOptions :: OrgOptions +defaultOrgOptions = + OrgOptions + { orgSrcPreserveIndentation = False + , orgSrcTabWidth = 4 + , orgTodoKeywords = [TodoKeyword Todo "TODO", TodoKeyword Done "DONE"] + , orgElementParsedKeywords = ["caption", "title", "date", "author"] + , orgElementDualKeywords = ["caption", "results"] + , orgElementAffiliatedKeywords = ["caption", "data", "header", "headers", "label", "name", "plot", "resname", "result", "source", "srcname", "tblname"] + } + +-- | Org-mode parser state +data OrgParserEnv = OrgParserEnv + { orgEnvOptions :: OrgOptions + , orgEnvIndentLevel :: Int + } + +-- | Org-mode parser state +newtype OrgParserState = OrgParserState + { orgStateLastChar :: Maybe Char + } + +defaultState :: OrgParserState +defaultState = + OrgParserState + { orgStateLastChar = Nothing + } + +defaultEnv :: OrgParserEnv +defaultEnv = + OrgParserEnv + { orgEnvOptions = defaultOrgOptions + , orgEnvIndentLevel = 0 + } + +aesonOptions :: Aeson.Options +aesonOptions = + Aeson.defaultOptions + { Aeson.fieldLabelModifier = Aeson.camelTo2 '-' + } diff --git a/src/Org/Types.hs b/src/Org/Types.hs new file mode 100644 --- /dev/null +++ b/src/Org/Types.hs @@ -0,0 +1,569 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Org.Types + ( -- * Document + OrgDocument (..) + , Properties + + -- ** Helpers + , lookupProperty + + -- * Sections + , OrgSection (..) + , TodoKeyword (..) + , TodoState (..) + , Tag + , Priority (..) + , PlanningInfo (..) + + -- ** Helpers + , lookupSectionProperty + + -- * OrgContent + , OrgContent + , documentContent + , mapContentM + , mapContent + , sectionContent + , mapSectionContentM + , mapSectionContent + + -- * Elements + , OrgElement (..) + , OrgElementData (..) + + -- ** Greater blocks + , GreaterBlockType (..) + + -- ** Source blocks + , SrcLine (..) + , srcLineContent + , srcLinesToText + , srcLineMap + + -- ** Lists + , ListType (..) + , OrderedStyle (..) + , orderedStyle + , ListItem (..) + , Bullet (..) + , Checkbox (..) + , listItemType + + -- ** Keywords + , Keywords + , KeywordValue (..) + , lookupValueKeyword + , lookupParsedKeyword + , lookupBackendKeyword + , keywordsFromList + + -- ** Tables + , TableRow (..) + , TableCell + , ColumnAlignment (..) + + -- * Objects + , OrgObject (..) + + -- ** Links + , LinkTarget (..) + , Protocol + , Id + , linkTargetToText + + -- ** LaTeX fragments + , FragmentType (..) + + -- ** Citations + , Citation (..) + , CiteReference (..) + + -- ** Footnote references + , FootnoteRefData (..) + + -- ** Timestamps + , TimestampData (..) + , DateTime + , TimestampMark + , Date + , Time + + -- * Quotes + , QuoteType (..) + + -- * Babel + , BabelCall (..) + ) where + +import Data.Aeson +import Data.Aeson.Encoding (text) +import Data.Char (isDigit, toLower) +import Data.Data (Data) +import Data.Map qualified as M +import Data.Text qualified as T + +-- * Document, Sections and Headings + +data OrgDocument = OrgDocument + { documentProperties :: Properties + , documentChildren :: [OrgElement] + , documentSections :: [OrgSection] + } + deriving (Eq, Ord, Read, Show, Generic) + deriving anyclass (NFData) + +lookupProperty :: Text -> OrgDocument -> Maybe Text +lookupProperty k = M.lookup k . documentProperties + +data OrgSection = OrgSection + { sectionLevel :: Int + , sectionProperties :: Properties + , sectionTodo :: Maybe TodoKeyword + , sectionIsComment :: Bool + , sectionPriority :: Maybe Priority + , sectionTitle :: [OrgObject] + , sectionRawTitle :: Text + , sectionAnchor :: Id + -- ^ Section custom ID (Warning: this field is not populated by the parser! in + -- the near future, fields like this one and the 'Id' type will be removed in + -- favor of AST extensibility). See also the documentation for 'LinkTarget' + , sectionTags :: [Tag] + , sectionPlanning :: PlanningInfo + , sectionChildren :: [OrgElement] + , sectionSubsections :: [OrgSection] + } + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +lookupSectionProperty :: Text -> OrgSection -> Maybe Text +lookupSectionProperty k = M.lookup k . sectionProperties + +type OrgContent = ([OrgElement], [OrgSection]) + +documentContent :: OrgDocument -> OrgContent +documentContent doc = (documentChildren doc, documentSections doc) + +mapContentM :: Monad m => (OrgContent -> m OrgContent) -> OrgDocument -> m OrgDocument +mapContentM f d = do + (c', s') <- f (documentContent d) + pure $ d {documentChildren = c', documentSections = s'} + +mapContent :: (OrgContent -> OrgContent) -> OrgDocument -> OrgDocument +mapContent f = runIdentity . mapContentM (Identity . f) + +sectionContent :: OrgSection -> OrgContent +sectionContent sec = (sectionChildren sec, sectionSubsections sec) + +mapSectionContentM :: Monad m => (OrgContent -> m OrgContent) -> OrgSection -> m OrgSection +mapSectionContentM f d = do + (c', s') <- f (sectionContent d) + pure $ d {sectionChildren = c', sectionSubsections = s'} + +mapSectionContent :: (OrgContent -> OrgContent) -> OrgSection -> OrgSection +mapSectionContent f = runIdentity . mapSectionContentM (Identity . f) + +type Tag = Text + +-- | The states in which a todo item can be +data TodoState = Todo | Done + deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +instance ToJSON TodoState where + toJSON Todo = "todo" + toJSON Done = "done" + toEncoding Todo = text "todo" + toEncoding Done = text "done" + +instance FromJSON TodoState where + parseJSON = + genericParseJSON + defaultOptions + { constructorTagModifier = map toLower + } + +-- | A to-do keyword like @TODO@ or @DONE@. +data TodoKeyword = TodoKeyword + { todoState :: TodoState + , todoName :: Text + } + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +instance ToJSON TodoKeyword where + toJSON (TodoKeyword s n) = object ["state" .= s, "name" .= n] + toEncoding (TodoKeyword s n) = pairs ("state" .= s <> "name" .= n) + +instance FromJSON TodoKeyword where + parseJSON = withObject "Todo Keyword" $ \v -> + TodoKeyword <$> v .: "state" <*> v .: "name" + +data Priority + = LetterPriority Char + | NumericPriority Int + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +type Date = (Int, Int, Int, Maybe Text) + +type Time = (Int, Int) + +type TimestampMark = (Text, Int, Char) + +type DateTime = (Date, Maybe Time, Maybe TimestampMark, Maybe TimestampMark) + +-- | An Org timestamp, including repetition marks. +data TimestampData + = TimestampData Bool DateTime + | TimestampRange Bool DateTime DateTime + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +-- | Planning information for a subtree/headline. +data PlanningInfo = PlanningInfo + { planningClosed :: Maybe TimestampData + , planningDeadline :: Maybe TimestampData + , planningScheduled :: Maybe TimestampData + } + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +type Properties = Map Text Text + +-- * Elements + +-- | Org element. Like a Pandoc Block. +data OrgElement = OrgElement {affiliatedKeywords :: Keywords, elementData :: OrgElementData} + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +data OrgElementData + = -- | Clock + Clock + TimestampData + -- ^ Clock timestamp + (Maybe Time) + -- ^ Duration + | -- | Greater block + GreaterBlock + { blkType :: GreaterBlockType + -- ^ Greater block type + , blkElements :: [OrgElement] + -- ^ Greater block elements + } + | -- | Drawer + Drawer + { drawerName :: Text + -- ^ Drawer name + , drawerElements :: [OrgElement] + -- ^ Drawer elements + } + | -- | Plain list + PlainList + { listType :: ListType + -- ^ List types + , listItems :: [ListItem] + -- ^ List items + } + | -- | Export block + ExportBlock + Text + -- ^ Format + Text + -- ^ Contents + | -- | Example block + ExampleBlock + (Map Text Text) + -- ^ Switches + [SrcLine] + -- ^ Contents + | -- | Source blocks + SrcBlock + { srcBlkLang :: Text + -- ^ Language + , srcBlkSwitches :: Map Text Text + -- ^ Switches + , srcBlkArguments :: [(Text, Text)] + -- ^ Header arguments + , srcBlkLines :: [SrcLine] + -- ^ Contents + } + | VerseBlock [[OrgObject]] + | HorizontalRule + | Keyword + { keywordKey :: Text + , keywordValue :: KeywordValue + } + | LaTeXEnvironment + Text + -- ^ Environment name + Text + -- ^ Environment contents + | Paragraph [OrgObject] + | Table [TableRow] + | FootnoteDef + Text + -- ^ Footnote name + [OrgElement] + -- ^ Footnote content + | Comment + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +data QuoteType = SingleQuote | DoubleQuote + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +data SrcLine + = SrcLine Text + | RefLine + Id + -- ^ Reference id (its anchor) + Text + -- ^ Reference name (how it appears) + Text + -- ^ Line contents + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +srcLineContent :: SrcLine -> Text +srcLineContent (SrcLine c) = c +srcLineContent (RefLine _ _ c) = c + +srcLinesToText :: [SrcLine] -> Text +srcLinesToText = T.unlines . map srcLineContent + +srcLineMap :: (Text -> Text) -> SrcLine -> SrcLine +srcLineMap f (SrcLine c) = SrcLine (f c) +srcLineMap f (RefLine i t c) = RefLine i t (f c) + +-- Keywords + +data KeywordValue + = ValueKeyword Text + | ParsedKeyword [OrgObject] + | BackendKeyword [(Text, Text)] + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +instance Semigroup KeywordValue where + (ValueKeyword t1) <> (ValueKeyword t2) = ValueKeyword (t1 <> "\n" <> t2) + (ParsedKeyword t1) <> (ParsedKeyword t2) = ParsedKeyword (t1 <> t2) + (BackendKeyword b1) <> (BackendKeyword b2) = BackendKeyword (b1 <> b2) + _ <> x = x + +type Keywords = Map Text KeywordValue + +lookupValueKeyword :: Text -> Keywords -> Text +lookupValueKeyword key kws = fromMaybe mempty do + ValueKeyword x <- M.lookup key kws + return x + +lookupParsedKeyword :: Text -> Keywords -> [OrgObject] +lookupParsedKeyword key kws = fromMaybe mempty do + ParsedKeyword x <- M.lookup key kws + return x + +lookupBackendKeyword :: Text -> Keywords -> [(Text, Text)] +lookupBackendKeyword key kws = fromMaybe mempty do + BackendKeyword x <- M.lookup key kws + return x + +keywordsFromList :: [(Text, KeywordValue)] -> Keywords +keywordsFromList = M.fromListWith (flip (<>)) + +-- Greater Blocks + +data GreaterBlockType = Center | Quote | Special Text + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +-- Lists + +data ListType = Ordered OrderedStyle | Descriptive | Unordered Char + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +data OrderedStyle = OrderedNum | OrderedAlpha + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +orderedStyle :: Text -> OrderedStyle +orderedStyle (T.any isDigit -> True) = OrderedNum +orderedStyle _ = OrderedAlpha + +{- | One item of a list. Parameters are bullet, counter cookie, checkbox and +tag. +-} +data ListItem = ListItem Bullet (Maybe Int) (Maybe Checkbox) [OrgObject] [OrgElement] + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +data Bullet = Bullet Char | Counter Text Char + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +data Checkbox = BoolBox Bool | PartialBox + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +listItemType :: ListItem -> ListType +listItemType (ListItem (Counter t _) _ _ _ _) = Ordered (orderedStyle t) +listItemType (ListItem (Bullet _) _ _ (_ : _) _) = Descriptive +listItemType (ListItem (Bullet c) _ _ _ _) = Unordered c + +-- Babel call + +data BabelCall = BabelCall + { babelCallName :: Text + , babelCallHeader1 :: Text + , babelCallHeader2 :: Text + , babelCallArguments :: Text + } + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +-- Tables + +data TableRow + = StandardRow [TableCell] + | ColumnPropsRow [Maybe ColumnAlignment] + | RuleRow + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +type TableCell = [OrgObject] + +data ColumnAlignment = AlignLeft | AlignCenter | AlignRight + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + deriving anyclass (NFData) + +-- * Objects (inline elements) + +-- | Objects (inline elements). +data OrgObject + = Plain Text + | LineBreak + | Italic [OrgObject] + | Underline [OrgObject] + | Bold [OrgObject] + | Strikethrough [OrgObject] + | Superscript [OrgObject] + | Subscript [OrgObject] + | Quoted QuoteType [OrgObject] + | Code Text + | Verbatim Text + | Timestamp TimestampData + | -- | Entity (e.g. @\\alpha{}@) + Entity + Text + -- ^ Name (e.g. @alpha@) + | LaTeXFragment FragmentType Text + | -- | Inline export snippet (e.g. @\@\@html:\
\@\@@) + ExportSnippet + Text + -- ^ Back-end (e.g. @html@) + Text + -- ^ Value (e.g. @\
@) + | -- | Footnote reference. + FootnoteRef FootnoteRefData + | Cite Citation + | InlBabelCall BabelCall + | -- | Inline source (e.g. @src_html[:foo bar]{\
}@) + Src + Text + -- ^ Language (e.g. @html@) + Text + -- ^ Parameters (e.g. @:foo bar@) + Text + -- ^ Value (e.g. @\
@) + | Link LinkTarget [OrgObject] + | -- | Inline target (e.g. @\<\<\\>\>@) + Target + Id + -- ^ Anchor (Warning: this field is not populated by the parser! --- in + -- the near future, fields like this one and the 'Id' type will be removed + -- in favor of AST extensibility). See also the documentation for + -- 'LinkTarget' + Text + -- ^ Name + | -- | Org inline macro (e.g. @{{{poem(red,blue)}}}@) + Macro + Text + -- ^ Macro name (e.g. @"poem"@) + [Text] + -- ^ Arguments (e.g. @["red", "blue"]@) + | -- | Statistic cookies. + StatisticCookie + (Either (Int, Int) Int) + -- ^ Either @[num1/num2]@ or @[percent%]@. + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +-- | Data for a footnote reference. +data FootnoteRefData + = -- | Label-only footnote reference (e.g. @[fn:foo]@) + FootnoteRefLabel + Text + -- ^ Label (e.g. @foo@) + | -- | Inline footnote definition (e.g. @[fn:foo::bar]@) + FootnoteRefDef + (Maybe Text) + -- ^ Label (if present, e.g. @foo@) + [OrgObject] + -- ^ Content (e.g. @bar@) + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +type Protocol = Text + +type Id = Text + +{- | Link target. Note that the parser does not resolve internal links. Instead, +they should be resolved using the functions in [@org-exporters@ +package](https://github.com/lucasvreis/org-mode-hs). In the near future, the +'InternalLink' constructor and 'Id' type will be removed in favor of AST +extensibility. See also the documentation for 'Target'. +-} +data LinkTarget + = URILink Protocol Text + | InternalLink Id + | UnresolvedLink Text + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +linkTargetToText :: LinkTarget -> Text +linkTargetToText = \case + URILink prot l -> prot <> ":" <> l + InternalLink l -> l + UnresolvedLink l -> l + +data FragmentType + = RawFragment + | InlMathFragment + | DispMathFragment + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +data Citation = Citation + { citationStyle :: Text + , citationVariant :: Text + , citationPrefix :: [OrgObject] + , citationSuffix :: [OrgObject] + , citationReferences :: [CiteReference] + } + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) + +data CiteReference = CiteReference + { refId :: Text + , refPrefix :: [OrgObject] + , refSuffix :: [OrgObject] + } + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + deriving anyclass (NFData) diff --git a/src/Org/Walk.hs b/src/Org/Walk.hs new file mode 100644 --- /dev/null +++ b/src/Org/Walk.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Org.Walk + ( module Org.Walk + , MultiWalk + , (.>) + , (?>) + ) +where + +import Control.MultiWalk +import Org.Types + +data MWTag + +type Walk = Control.MultiWalk.Walk MWTag Identity + +type WalkM m = Control.MultiWalk.Walk MWTag m + +type Query m = Control.MultiWalk.Query MWTag m + +query :: (MultiWalk MWTag c, MultiWalk MWTag t, Monoid m) => (t -> m) -> c -> m +query = Control.MultiWalk.query @MWTag + +walkM :: (MultiWalk MWTag c, MultiWalk MWTag t, Monad m) => (t -> m t) -> c -> m c +walkM = Control.MultiWalk.walkM @MWTag + +walk :: (MultiWalk MWTag c, MultiWalk MWTag t) => (t -> t) -> c -> c +walk = Control.MultiWalk.walk @MWTag + +buildMultiQ :: + (MultiWalk MWTag a, Monoid m) => + (Org.Walk.Query m -> QList m (MultiTypes MWTag) -> QList m (MultiTypes MWTag)) -> + a -> + m +buildMultiQ = Control.MultiWalk.buildMultiQ @MWTag + +buildMultiW :: + (MultiWalk MWTag a, Applicative m) => + (Org.Walk.WalkM m -> FList m (MultiTypes MWTag) -> FList m (MultiTypes MWTag)) -> + a -> + m a +buildMultiW = Control.MultiWalk.buildMultiW @MWTag + +instance MultiTag MWTag where + type + MultiTypes MWTag = + '[ OrgDocument + , OrgSection + , -- Element stuff + OrgElement + , OrgElementData + , ListItem + , -- Object stuff + OrgObject + , Citation + ] + +type List a = Trav [] a + +type DoubleList a = MatchWith [[a]] (Trav (Compose [] []) a) + +instance MultiSub MWTag OrgDocument where + type SubTypes MWTag OrgDocument = 'SpecList '[ToSpec (List OrgElement), ToSpec (List OrgSection)] + +instance MultiSub MWTag OrgElement where + type + SubTypes MWTag OrgElement = + 'SpecList + '[ ToSpec OrgElementData + , ToSpec (Trav (Map Text) (Under KeywordValue 'NoSel (List OrgObject))) -- Objects under affiliated keywords + ] + +instance MultiSub MWTag OrgElementData where + type + SubTypes MWTag OrgElementData = + 'SpecList + '[ ToSpec (List OrgElement) + , ToSpec (List OrgObject) + , ToSpec (Under KeywordValue 'NoSel (List OrgObject)) -- Objects under keywords + , ToSpec (List ListItem) + , ToSpec (List (Under TableRow 'NoSel (DoubleList OrgObject))) -- Objects under table rows + , ToSpec (DoubleList OrgObject) -- Objects under verse blocks + ] + +instance MultiSub MWTag ListItem where + type + SubTypes MWTag ListItem = + 'SpecList + '[ ToSpec (List OrgObject) + , ToSpec (List OrgElement) + ] + +instance MultiSub MWTag OrgSection where + type + SubTypes MWTag OrgSection = + 'SpecList + '[ ToSpec (List OrgObject) + , ToSpec (List OrgElement) + , ToSpec (List OrgSection) + ] + +instance MultiSub MWTag OrgObject where + type + SubTypes MWTag OrgObject = + 'SpecList + '[ ToSpec (List OrgObject) + , ToSpec (Under FootnoteRefData 'NoSel (List OrgElement)) + , ToSpec Citation + ] + +instance MultiSub MWTag Citation where + type + SubTypes MWTag Citation = + 'SpecList + '[ ToSpec (List OrgObject) + , ToSpec (List (Under CiteReference 'NoSel (List OrgObject))) + ] diff --git a/test/Tests/Document.hs b/test/Tests/Document.hs new file mode 100644 --- /dev/null +++ b/test/Tests/Document.hs @@ -0,0 +1,28 @@ +module Tests.Document where + +import NeatInterpolation +import Org.Parser.Document (propertyDrawer) +import Tests.Helpers + +testDocument :: TestTree +testDocument = + testGroup + "Document" + [ "Property drawer" ~: propertyDrawer $ + [ [text| :pRoPerTieS: + :Fo^o3': bar + :foobar: + :fooBARbar: bla bla + :ENd: + |] + =?> fromList + [ ("fo^o3'", "bar"), + ("foobar", ""), + ("foobarbar", "bla bla") + ], + [text|:properties: + :end: + |] + =?> mempty + ] + ] diff --git a/test/Tests/Elements.hs b/test/Tests/Elements.hs new file mode 100644 --- /dev/null +++ b/test/Tests/Elements.hs @@ -0,0 +1,300 @@ +module Tests.Elements where + +import NeatInterpolation +import Org.Builder qualified as B +import Org.Parser.Elements +import Org.Types +import Tests.Helpers + +testElements :: TestTree +testElements = + testGroup + "Elements" + [ "Clock" ~: clock $ + [ "CLOCK: [2012-11-18 Sun 19:26]--[2012-11-18 Sun 19:33] => 0:07\n" + =?> let dt1 = ((2012, 11, 18, Just "Sun"), Just (19, 26), Nothing, Nothing) + dt2 = ((2012, 11, 18, Just "Sun"), Just (19, 33), Nothing, Nothing) + in B.clock (TimestampRange False dt1 dt2) (Just (0, 7)) + ] + , "Clocks in context" ~: elements $ + [ [text| + foo + CLOCK: [2012-11-18 Sun 19:26]--[2012-11-18 Sun 19:33] => 0:07 + bar + |] + =?> let dt1 = ((2012, 11, 18, Just "Sun"), Just (19, 26), Nothing, Nothing) + dt2 = ((2012, 11, 18, Just "Sun"), Just (19, 33), Nothing, Nothing) + in "foo" + <> B.element (B.clock (TimestampRange False dt1 dt2) (Just (0, 7))) + <> "bar" + ] + , "Comment line" ~: commentLine $ + [ "# this is a comment" =?> Comment + , "#this line is not a comment" =!> () + ] + , "Paragraph" ~: elements $ + [ -- + [text| + foobar + baz + |] + =?> B.element (B.para ("foobar" <> "\n" <> "baz")) + , [text| + with /wrapped + markup/ and markup *at end* + =at start= but not~here~ and + not _here_right. + |] + =?> B.element + ( B.para + ( "with " + <> B.italic "wrapped\nmarkup" + <> " and markup " + <> B.bold "at end" + <> "\n" + <> B.verbatim "at start" + <> " but not~here~ and\nnot _here" + <> B.subscript (B.plain "right") + <> B.plain "." + ) + ) + ] + , "Affiliated Keywords in Context" ~: elements $ + [ -- + [text| + #+attr_html: :width 40px :foo bar:joined space :liz buuz + Hi + |] + =?> let kw = + BackendKeyword + [ ("width", "40px") + , ("foo", "bar:joined space") + , ("liz", "buuz") + ] + in B.element' [("attr_html", kw)] (B.para "Hi") + , [text| + Some para + #+caption: hi /guys/ + + Hi + |] + =?> foldMap + B.element + [ B.para "Some para" + , B.keyword "caption" (B.parsedKeyword $ "hi " <> B.italic "guys") + , B.para "Hi" + ] + , [text| + #+attr_html: :style color: red + - foo + |] + =?> let kw = BackendKeyword [("style", "color: red")] + in B.element' + [("attr_html", kw)] + ( B.list + (Unordered '-') + [B.listItemUnord '-' $ B.element $ B.para "foo"] + ) + , [text| + Some para + #+caption: hi /guys/ + Hi + |] + =?> let kw = B.parsedKeyword ("hi " <> B.italic "guys") + in B.element (B.para "Some para") + <> B.element' [("caption", kw)] (B.para "Hi") + , [text| + #+attr_org: :foo bar + #+begin_center + Some para + #+caption: hi /guys/ + #+end_center + I don't have a caption + |] + =?> let kw1 = BackendKeyword [("foo", "bar")] + kw2 = B.parsedKeyword ("hi " <> B.italic "guys") + in B.element' + [("attr_org", kw1)] + ( B.greaterBlock + Center + ( foldMap B.element [B.para "Some para", B.keyword "caption" kw2] + ) + ) + <> B.element (B.para "I don't have a caption") + ] + , "Ordered Lists" ~: plainList $ + [ -- + unlines + [ "1. our" + , "2. moment's" + , "3. else's" + ] + =?> B.orderedList OrderedNum '.' ["our", "moment's", "else's"] + ] + , "Descriptive Lists" ~: plainList $ + [ "- foo :: bar" + =?> B.descriptiveList [("foo", "bar")] + , "- foo bar :: baz" + =?> B.descriptiveList [("foo bar", "baz")] + , "- :: ::" =?> B.descriptiveList [("::", mempty)] + , "- :: foo ::" =?> B.descriptiveList [(":: foo", mempty)] + , "- :: :: bar" =?> B.descriptiveList [("::", "bar")] + , "- :: :::" =?> B.list (Unordered '-') [B.listItemUnord '-' ":: :::"] + , "- /foo/ :: bar" + =?> B.descriptiveList [(B.italic "foo", "bar")] + , "- [[foo][bar]] :: bar" + =?> B.descriptiveList [(B.link (UnresolvedLink "foo") "bar", "bar")] + , "- [[foo:prot.co][bar baz]] :: bla :: ble" + =?> B.descriptiveList [(B.link (URILink "foo" "prot.co") "bar baz", "bla :: ble")] + ] + , "Lists in context" ~: elements $ + [ -- + unlines + [ "- foo bar" + , "" + , " #+caption: foo" + , "bla" + ] + =?> B.element + ( B.list + (Unordered '-') + [ B.listItemUnord '-' $ + "foo bar" <> B.element (B.keyword "caption" $ B.parsedKeyword "foo") + ] + ) + <> "bla" + , unlines + [ "- foo bar" + , "#+caption: foo" + , " bla" + ] + =?> B.element + ( B.list + (Unordered '-') + [ B.listItemUnord '-' "foo bar" + ] + ) + <> B.element' [("caption", B.parsedKeyword "foo")] (B.para "bla") + , unlines + [ "- " + , " * " + , " - foo" + , " -" + , " + " + , "+" + ] + =?> B.element + ( B.list + (Unordered '-') + [ B.listItemUnord '-' $ + B.element $ + B.list + (Unordered '*') + [ B.listItemUnord '*' mempty + , B.listItemUnord '-' "foo" + , B.listItemUnord '-' mempty + , B.listItemUnord '+' mempty + ] + , B.listItemUnord '+' mempty + ] + ) + , unlines + [ "- " + , "" + , "- foo" + , " " + , " " + , " * bar" + , " *" + , "" + , "" + , " - doo" + ] + =?> B.element + ( B.list + (Unordered '-') + [ B.listItemUnord '-' mempty + , B.listItemUnord '-' "foo" + ] + ) + <> B.element + ( B.list + (Unordered '*') + [ B.listItemUnord '*' "bar" + , B.listItemUnord '*' mempty + ] + ) + <> B.element + ( B.list + (Unordered '-') + [ B.listItemUnord '-' "doo" + ] + ) + , unlines + [ " " + , " 1. our" + , " 2. moment's" + , " 3. else's" + ] + =?> B.element + ( B.orderedList + OrderedNum + '.' + (map (B.element . B.para) ["our", "moment's", "else's"]) + ) + ] + , "Greater Blocks" ~: greaterBlock $ + [ -- + unlines + [ "#+begin_fun" + , " " + , "#+end_fun" + ] + =?> B.greaterBlock (Special "fun") mempty + ] + , "Fixed width" ~: fixedWidth $ + [ -- + [text| + : fooblabla boo + : foooo + : booo + |] + =?> B.example + mempty + [ SrcLine " fooblabla boo" + , SrcLine "foooo" + , SrcLine " booo" + ] + ] + , "Horizontal Rules" ~: horizontalRule $ + [ "---------------- " + =?> B.horizontalRule + , "-- " + =!> () + ] + , "Tables" ~: table $ + [ -- + [text| + | foo | bar | baz | + |foo bar | baz + |---- + | | | | + | | foo /bar/ | *ba* | baz + | foo || bar | | + |] + =?> B.table + [ B.standardRow ["foo", "bar", "baz"] + , B.standardRow ["foo bar", "baz"] + , RuleRow + , ColumnPropsRow [Just AlignRight, Nothing, Just AlignLeft, Just AlignCenter] + , B.standardRow ["", "foo " <> B.italic "bar", B.bold "ba", "baz"] + , B.standardRow ["foo", mempty, "bar", mempty] + ] + ] + , "Tricky whitespace" ~: elements $ + [ "\n " =?> mempty + , "" =?> mempty + , "\n" =?> mempty + , "\n\n a" =?> B.element (B.para "a") + ] + ] diff --git a/test/Tests/Helpers.hs b/test/Tests/Helpers.hs new file mode 100644 --- /dev/null +++ b/test/Tests/Helpers.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Tests.Helpers + ( module Tests.Helpers + , module Test.Tasty + ) +where + +import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff) +import Org.Builder (Many) +import Org.Parser +import Org.Parser.Objects (Marked (..)) +import Org.Types (OrgDocument, OrgElementData, Properties) +import Test.Tasty +import Test.Tasty.HUnit +import Text.Megaparsec (eof) +import Text.Megaparsec.Error (errorBundlePretty) +import Text.Pretty.Simple +import Text.PrettyPrint (render, text) + +{- | This class is mainly used for the tests cases. +@Parsed m a@ is the "monad-stripped" version of parse +tree with which we can compare in the test cases. +-} +class Parsable m a where + type Parsed m a + parse' :: m a -> Text -> Either OrgParseError (Parsed m a) + +instance Parsable OrgParser a where + type Parsed OrgParser a = a + parse' p = parseOrg defaultOrgOptions (p <* eof) "" + +instance Parsable (Marked OrgParser) a where + type Parsed (Marked OrgParser) a = a + parse' p = parse' (getParser p) + +instance PrettyFormable Properties where + type PrettyForm Properties = Properties + prettyForm = id + +instance Parsable OrgParser OrgDocument where + type Parsed OrgParser OrgDocument = OrgDocument + parse' p = parseOrg defaultOrgOptions (p <* eof) "" + +instance PrettyFormable OrgDocument where + type PrettyForm OrgDocument = OrgDocument + prettyForm = id + +class PrettyFormable a where + type PrettyForm a + prettyForm :: a -> PrettyForm a + +instance PrettyFormable (Many a) where + type PrettyForm (Many a) = [a] + prettyForm = toList + +instance PrettyFormable OrgElementData where + type PrettyForm OrgElementData = OrgElementData + prettyForm = id + +prettyParse :: (Parsable m a, PrettyFormable (Parsed m a), Show (PrettyForm (Parsed m a))) => m a -> Text -> IO () +prettyParse parser txt = + case parse' parser txt of + Left e -> putStrLn $ errorBundlePretty e + Right x -> pPrint $ prettyForm x + +infix 1 =?> + +(=?>) :: a -> b -> (a, Either () b) +x =?> y = (x, Right y) + +infix 1 =!> + +(=!>) :: a -> () -> (a, Either () c) +x =!> y = (x, Left y) + +infix 4 =: + +(=:) :: (Eq a, Show a) => TestName -> (a, a) -> TestTree +(=:) name (x, y) = testCase name (x @?= y) + +infix 4 ~: + +(~:) :: + HasCallStack => + (Parsable m a, PrettyFormable (Parsed m a), Eq (Parsed m a), Show (Parsed m a)) => + TestName -> + m a -> + [(Text, Either () (Parsed m a))] -> + TestTree +(~:) name parser cases = + testGroup name $ + flip (`zipWith` [1 ..]) cases $ \(i :: Int) (txt, ref) -> + testCase (name <> " " <> show i) $ + case parse' parser txt of + Left e + | isRight ref -> assertFailure $ errorBundlePretty e + | otherwise -> pure () + Right x + | Right ref' <- ref -> + unless (x == ref') do + let reflines = map toString $ lines (toStrict $ pShow ref') + gotlines = map toString $ lines (toStrict $ pShow x) + diff = getContextDiff 3 reflines gotlines + pdiff = prettyContextDiff (text "Test reference") (text "Parsed") text diff + assertFailure (render pdiff) + | otherwise -> + assertFailure $ + "Should not parse, but parsed as:\n" <> show x diff --git a/test/Tests/Objects.hs b/test/Tests/Objects.hs new file mode 100644 --- /dev/null +++ b/test/Tests/Objects.hs @@ -0,0 +1,103 @@ +module Tests.Objects where + +import Org.Builder qualified as B +import Org.Parser.Objects +import Org.Types +import Tests.Helpers + +testObjects :: TestTree +testObjects = + testGroup + "Objects" + [ "Timestamp" ~: timestamp $ + [ "<1997-11-03 Mon 19:15>" + =?> B.timestamp + (TimestampData True ((1997, 11, 3, Just "Mon"), Just (19, 15), Nothing, Nothing)) + , "[2020-03-04 20:20]" + =?> B.timestamp + (TimestampData False ((2020, 03, 04, Nothing), Just (20, 20), Nothing, Nothing)) + , "[2020-03-04 0:20]" + =?> B.timestamp + (TimestampData False ((2020, 03, 04, Nothing), Just (0, 20), Nothing, Nothing)) + ] + , "Citations" ~: citation $ + [ "[cite:/foo/;/bar/@bef=bof=;/baz/]" + =?> let ref = + CiteReference + { refId = "bef" + , refPrefix = [Italic [Plain "bar"]] + , refSuffix = [Verbatim "bof"] + } + in B.citation + Citation + { citationStyle = "" + , citationVariant = "" + , citationPrefix = [Italic [Plain "foo"]] + , citationSuffix = [Italic [Plain "baz"]] + , citationReferences = [ref] + } + ] + , "Targets" ~: target $ + [ "<>" =?> B.target "" "this is a target" + , "<< not a target>>" =!> () + , "<>" =!> () + , "<>" =!> () + , "<>" =!> () + , "< is not a target>>" =!> () + ] + , "Math fragment" ~: latexFragment $ + [ "\\(\\LaTeX + 2\\)" =?> B.inlMath "\\LaTeX + 2" + , "\\[\\LaTeX + 2\\]" =?> B.dispMath "\\LaTeX + 2" + ] + , "TeX Math Fragments" ~: plainMarkupContext texMathFragment $ + [ "$e = mc^2$" =?> B.inlMath "e = mc^2" + , "$$foo bar$" =?> "$$foo bar$" + , "$foo bar$a" =?> "$foo bar$a" + , "($foo bar$)" =?> "(" <> B.inlMath "foo bar" <> ")" + , "This is $1 buck, not math ($1! so cheap!)" =?> "This is $1 buck, not math ($1! so cheap!)" + , "two$$always means$$math" =?> "two" <> B.dispMath "always means" <> "math" + ] + , "Subscripts and superscripts" ~: plainMarkupContext suscript $ + [ "not a _suscript" =?> "not a _suscript" + , "not_{{suscript}" =?> "not_{{suscript}" + , "a_{balanced^{crazy} ok}" =?> "a" <> B.subscript ("balanced" <> B.superscript "crazy" <> " ok") + , "a_{balanced {suscript} ok}" =?> "a" <> B.subscript "balanced {suscript} ok" + , "a_{bala\nnced {sus\ncript} ok}" =?> "a" <> B.subscript "bala\nnced {sus\ncript} ok" + , "a^+strange,suscript," =?> "a" <> B.superscript "+strange,suscript" <> "," + , "a^*suspicious suscript" =?> "a" <> B.superscript "*" <> "suspicious suscript" + , "a_bad,.,.,maleficent, one" =?> "a" <> B.subscript "bad,.,.,maleficent" <> ", one" + , "a_some\\LaTeX" =?> "a" <> B.subscript ("some" <> B.fragment "\\LaTeX") + ] + , "Line breaks" ~: plainMarkupContext linebreak $ + [ "this is a \\\\ \t\n\ + \line break" + =?> "this is a " + <> B.linebreak + <> "line break" + , "also linebreak \\\\" =?> "also linebreak " <> B.linebreak + ] + , "Image or links" ~: regularLink $ + [ "[[http://blablebli.com]]" =?> B.link (URILink "http" "//blablebli.com") mempty + , "[[http://blablebli.com][/uh/ duh! *foo*]]" =?> B.link (URILink "http" "//blablebli.com") (B.italic "uh" <> " duh! " <> B.bold "foo") + ] + , "Statistic Cookies" ~: statisticCookie $ + [ "[13/18]" =?> B.statisticCookie (Left (13, 18)) + , "[33%]" =?> B.statisticCookie (Right 33) + ] + , "Footnote references" ~: footnoteReference $ + [ "[fn::simple]" =?> B.footnoteInlDef Nothing "simple" + , "[fn::s[imple]" =!> () + , "[fn:mydef:s[imp]le]" =?> B.footnoteInlDef (Just "mydef") "s[imp]le" + ] + , "Macros" ~: macro $ + [ "{{{fooo()}}}" =?> B.macro "fooo" [""] + , "{{{função()}}}" =!> () + , "{{{2fun()}}}" =!> () + , "{{{fun-2_3(bar,(bar,baz){a})}}}" =?> B.macro "fun-2_3" ["bar", "(bar", "baz){a}"] + ] + , "Italic" ~: italic $ + [ "// foo/" =?> B.italic "/ foo" + , "/foo //" =?> B.italic "foo /" + , "/foo / f/" =?> B.italic "foo / f" + ] + ] diff --git a/test/test-org-parser.hs b/test/test-org-parser.hs new file mode 100644 --- /dev/null +++ b/test/test-org-parser.hs @@ -0,0 +1,30 @@ +module Main + ( module Main, + module Tests.Helpers, + module Org.Parser.Document, + module Org.Parser.Elements, + module Org.Parser.Objects, + ) +where + +import Org.Parser.Document +import Org.Parser.Elements +import Org.Parser.Objects +import Test.Tasty +import Tests.Document +import Tests.Elements +import Tests.Helpers +import Tests.Objects + +tests :: TestTree +tests = + testGroup + "Org parser tests" + [ testObjects, + testElements, + testDocument + ] + +main :: IO () +main = do + defaultMain tests