diff --git a/org-exporters/src/Org/Exporters/Processing/OrgData.hs b/org-exporters/src/Org/Exporters/Processing/OrgData.hs index c0f9c36..789cf59 100644 --- a/org-exporters/src/Org/Exporters/Processing/OrgData.hs +++ b/org-exporters/src/Org/Exporters/Processing/OrgData.hs @@ -130,7 +130,11 @@ data OrgData = OrgData , footnotes :: Map FootnoteLabel (Id, Either OrgObjects OrgElements) , bibliography :: [(Text, CslJson Text)] } - deriving (Eq, Ord, Show, Typeable, Generic) + deriving (Eq, Ord, Show, Typeable, Generic, NFData) + +-- FIXME upstream +deriving instance (Generic (CslJson Text)) +deriving instance (NFData (CslJson Text)) initialOrgData :: OrgData initialOrgData = OrgData mempty [] defaultExporterSettings defaultOrgOptions mempty mempty [] diff --git a/org-exporters/src/Org/Types/Variants/Annotated.hs b/org-exporters/src/Org/Types/Variants/Annotated.hs index e857918..1a30867 100644 --- a/org-exporters/src/Org/Types/Variants/Annotated.hs +++ b/org-exporters/src/Org/Types/Variants/Annotated.hs @@ -57,10 +57,10 @@ data OrgF k ix = OrgF {props :: StandardProperties, annotations :: Object, datum instance TestIxEq (OrgF k) where testIxEq x y = testIxEq x y.datum -deriving instance (Eq (P.OrgF k a)) => (Eq (OrgF k a)) -deriving instance (Ord (P.OrgF k a)) => (Ord (OrgF k a)) -deriving instance (Show (P.OrgF k a)) => (Show (OrgF k a)) -deriving instance (NFData (P.OrgF k a)) => (NFData (OrgF k a)) +deriving instance (AllOrgIx Eq k) => (Eq (OrgF k a)) +deriving instance (AllOrgIx Ord k) => (Ord (OrgF k a)) +deriving instance (AllOrgIx Show k) => (Show (OrgF k a)) +deriving instance (AllOrgIx NFData k) => (NFData (OrgF k ix)) $(deriveGenericK ''OrgF) deriving via (Generically OrgF) instance (Endofunctor (~>) OrgF) diff --git a/org-exporters/test/test-org-exporters.hs b/org-exporters/test/test-org-exporters.hs index 90e8177..c5bcb86 100644 --- a/org-exporters/test/test-org-exporters.hs +++ b/org-exporters/test/test-org-exporters.hs @@ -17,7 +17,7 @@ import Org.Exporters.LaTeX qualified as L import Org.Exporters.Pandoc qualified as P import Org.Exporters.Processing (OrgData, processAll) import Org.Parser (defaultOrgOptions, parseOrgDoc) -import Org.Types (OrgDocument) +import Org.Types.Variants.Annotated (OrgDocument) import Relude.Unsafe (fromJust) import System.Directory qualified as D import System.FilePath (takeBaseName, ()) diff --git a/org-parser/org-parser.cabal b/org-parser/org-parser.cabal index 50f4a70..9412038 100644 --- a/org-parser/org-parser.cabal +++ b/org-parser/org-parser.cabal @@ -98,11 +98,12 @@ test-suite test hs-source-dirs: test main-is: test-org-parser.hs build-depends: - , neat-interpolation >=0.5 && <0.6 + , filepath >=1.4.2 && <1.5 + , neat-interpolation >=0.5 && <0.6 , org-parser - , tasty >=1.4 && <1.5 - , tasty-hunit >=0.10 && <0.11 - , tree-diff >=0.3 && <0.4 + , tasty >=1.4 && <1.5 + , tasty-golden >=2.3 && <2.4 + , tree-diff >=0.3 && <0.4 other-modules: Tests.Document diff --git a/org-parser/src/Org/Parser/Definitions.hs b/org-parser/src/Org/Parser/Definitions.hs index 59a4706..1d78c28 100644 --- a/org-parser/src/Org/Parser/Definitions.hs +++ b/org-parser/src/Org/Parser/Definitions.hs @@ -71,17 +71,20 @@ getsO f = asks (f . (.options)) -- * Marked parsers -data Marked a = Marked +data Marked m a = Marked { marks :: String - , parser :: a + , parser :: m a } deriving (Functor) -instance (Alternative m) => Semigroup (Marked (m a)) where +mapMarkedP :: (m a -> n b) -> Marked m a -> Marked n b +mapMarkedP f m = m { parser = f m.parser } + +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 +instance (Alternative m) => Monoid (Marked m a) where mempty = Marked [] empty mconcat ms = Marked diff --git a/org-parser/src/Org/Parser/Elements.hs b/org-parser/src/Org/Parser/Elements.hs index 145903a..04bc2ca 100644 --- a/org-parser/src/Org/Parser/Elements.hs +++ b/org-parser/src/Org/Parser/Elements.hs @@ -132,9 +132,9 @@ paraIndented begin minI kws = end :: OrgParser (Int, Int, OrgElements) end = - eofEnd <|> do + eofEnd <|> try do _ <- newline - postBlank <- length <$> many blankline + postBlank <- length <$> lookAhead (many blankline) liftA2 (,postBlank,) getOffset do ((blanklineEnd <|> indentEnd <|> headingEnd) $> mempty) <|> elementIndented minI True diff --git a/org-parser/src/Org/Parser/MarkupContexts.hs b/org-parser/src/Org/Parser/MarkupContexts.hs index d0e8062..a89f95d 100644 --- a/org-parser/src/Org/Parser/MarkupContexts.hs +++ b/org-parser/src/Org/Parser/MarkupContexts.hs @@ -120,7 +120,7 @@ withBalancedContext lchar rchar allowed p = try do markupContext :: Monoid k => (Int -> Int -> Text -> k) -> - Marked (OrgParser k) -> + Marked OrgParser k -> OrgParser k markupContext f elems = go where diff --git a/org-parser/src/Org/Parser/Objects.hs b/org-parser/src/Org/Parser/Objects.hs index dbae0c4..de9d321 100644 --- a/org-parser/src/Org/Parser/Objects.hs +++ b/org-parser/src/Org/Parser/Objects.hs @@ -8,6 +8,7 @@ module Org.Parser.Objects , Marked (..) , markupContext , plainMarkupContext + , mapMarkedP -- * General purpose parsers , markup @@ -42,6 +43,7 @@ module Org.Parser.Objects -- * Auxiliary , linkToTarget , parseTimestamp + , withPos ) where @@ -62,10 +64,10 @@ withPos p = do -- * Sets of objects -minimalSet :: Marked (OrgParser OrgObjects) +minimalSet :: Marked OrgParser OrgObjects minimalSet = - withPos - <$> mconcat + mapMarkedP withPos + $ mconcat [ endline , code , verbatim @@ -83,11 +85,11 @@ minimalSet = , macro ] -standardSet :: Marked (OrgParser OrgObjects) +standardSet :: Marked OrgParser OrgObjects standardSet = (minimalSet <>) - $ withPos - <$> mconcat + . mapMarkedP withPos + $ mconcat [ regularLink , footnoteReference , timestamp @@ -107,7 +109,7 @@ standardSet = 'plainMarkupContext' = 'markupContext' 'B.plain' @ -} -plainMarkupContext :: Marked (OrgParser OrgObjects) -> OrgParser OrgObjects +plainMarkupContext :: Marked OrgParser OrgObjects -> OrgParser OrgObjects plainMarkupContext = markupContext (\s e t -> object s e (Plain t)) newlineAndClear :: OrgParser Char @@ -149,7 +151,7 @@ emphasisSkip s = try $ do markup :: (OrgObjects -> OrgObjectD) -> Char -> - Marked (OrgParser OrgObjectD) + Marked OrgParser OrgObjectD markup f c = Marked [c] $ try do emphasisPre c st <- getFullState @@ -160,53 +162,53 @@ markup f c = Marked [c] $ try do rawMarkup :: (Text -> OrgObjectData Org ObjIx) -> Char -> - Marked (OrgParser OrgObjectD) + Marked OrgParser OrgObjectD rawMarkup f d = Marked [d] $ try do emphasisPre d f . fst <$> skipManyTill' (emphasisSkip d) (emphasisPost d) -- | Parse a code object. -code :: Marked (OrgParser OrgObjectD) +code :: Marked OrgParser OrgObjectD code = rawMarkup Code '~' -- | Parse a verbatim object. -verbatim :: Marked (OrgParser OrgObjectD) +verbatim :: Marked OrgParser OrgObjectD verbatim = rawMarkup Verbatim '=' -- | Parse an italic object. -italic :: Marked (OrgParser OrgObjectD) +italic :: Marked OrgParser OrgObjectD italic = markup Italic '/' -- | Parse an underline object. -underline :: Marked (OrgParser OrgObjectD) +underline :: Marked OrgParser OrgObjectD underline = markup Underline '_' -- | Parse a bold object. -bold :: Marked (OrgParser OrgObjectD) +bold :: Marked OrgParser OrgObjectD bold = markup Bold '*' -- | Parse a strikethrough object. -strikethrough :: Marked (OrgParser OrgObjectD) +strikethrough :: Marked OrgParser OrgObjectD strikethrough = markup Strikethrough '+' -- | Parse a single-quoted object. -singleQuoted :: Marked (OrgParser OrgObjectD) +singleQuoted :: Marked OrgParser OrgObjectD singleQuoted = markup (Quoted SingleQuote) '\'' -- | Parse a double-quoted object. -doubleQuoted :: Marked (OrgParser OrgObjectD) +doubleQuoted :: Marked OrgParser OrgObjectD doubleQuoted = markup (Quoted DoubleQuote) '"' -- TODO why is this parsed? can't it live inside plain?? -- | An endline character that can be treated as a space, not a line break. -endline :: Marked (OrgParser OrgObjectD) +endline :: Marked OrgParser OrgObjectD endline = Marked "\n" $ try $ newlineAndClear *> hspace $> Plain "\n" -- * Entities and LaTeX fragments -- | Parse an entity object. -entity :: Marked (OrgParser OrgObjectD) +entity :: Marked OrgParser OrgObjectD entity = Marked "\\" $ try do _ <- char '\\' name <- choice (map string defaultEntitiesNames) @@ -214,7 +216,7 @@ entity = Marked "\\" $ try do pure $ Entity name -- | Parse a LaTeX fragment object. -latexFragment :: Marked (OrgParser OrgObjectD) +latexFragment :: Marked OrgParser OrgObjectD latexFragment = Marked "\\" $ try do _ <- char '\\' mathFragment <|> rawFragment @@ -247,7 +249,7 @@ latexFragment = Marked "\\" $ try do pure $ open `T.cons` str `T.snoc` close -- | Parse a TeX math fragment object. -texMathFragment :: Marked (OrgParser OrgObjectD) +texMathFragment :: Marked OrgParser OrgObjectD texMathFragment = Marked "$" $ try $ display <|> inline where display = try $ do @@ -293,7 +295,7 @@ texMathFragment = Marked "$" $ try $ display <|> inline -- * Export snippets -- | Parse an export snippet object. -exportSnippet :: Marked (OrgParser OrgObjectD) +exportSnippet :: Marked OrgParser OrgObjectD exportSnippet = Marked "@" $ try do _ <- string "@@" backend <- @@ -308,7 +310,7 @@ exportSnippet = Marked "@" $ try do -- The following code for org-cite citations was adapted and improved upon pandoc's. -- | Parse a citation object. -citation :: Marked (OrgParser OrgObjectD) +citation :: Marked OrgParser OrgObjectD citation = Marked "[" do Cite <$> withBalancedContext '[' ']' (const True) orgCite @@ -395,7 +397,7 @@ orgCiteKeyChar c = -- * Inline Babel calls -- | Parse an inline babel call object. -inlBabel :: Marked (OrgParser OrgObjectD) +inlBabel :: Marked OrgParser OrgObjectD inlBabel = Marked "c" $ try do _ <- string "call_" name <- @@ -413,7 +415,7 @@ inlBabel = Marked "c" $ try do -- * Inline source blocks -- | Parse an inline source object. -inlSrc :: Marked (OrgParser OrgObjectD) +inlSrc :: Marked OrgParser OrgObjectD inlSrc = Marked "s" $ try do _ <- string "src_" name <- @@ -429,14 +431,14 @@ inlSrc = Marked "s" $ try do -- * Line breaks -- | Parse a linebreak object. -linebreak :: Marked (OrgParser OrgObjectD) +linebreak :: Marked OrgParser OrgObjectD linebreak = Marked "\\" $ try do LineBreak <$ string "\\\\" <* blankline' <* clearLastChar -- * Links -- | Parse a angle link object. -angleLink :: Marked (OrgParser OrgObjectD) +angleLink :: Marked OrgParser OrgObjectD angleLink = Marked "<" $ try do _ <- char '<' s <- getOffset @@ -452,7 +454,7 @@ angleLink = Marked "<" $ try do return $ Link (URILink protocol tgt) (object s (e - 1) $ Plain $ protocol <> ":" <> tgt) -- | Parse a regular link object. -regularLink :: Marked (OrgParser OrgObjectD) +regularLink :: Marked OrgParser OrgObjectD regularLink = Marked "[" $ try do _ <- string "[[" str <- linkTarget @@ -498,7 +500,7 @@ linkToTarget link -- * Targets and radio targets -- | Parse a target object. -target :: Marked (OrgParser OrgObjectD) +target :: Marked OrgParser OrgObjectD target = Marked "<" $ try do _ <- string "<<" str <- takeWhile1P (Just "dedicated target") (\c -> c /= '<' && c /= '>' && c /= '\n') @@ -510,7 +512,7 @@ target = Marked "<" $ try do -- * Subscripts and superscripts -- | Parse a subscript or a superscript object. -suscript :: Marked (OrgParser OrgObjectD) +suscript :: Marked OrgParser OrgObjectD suscript = Marked "_^" $ try do lchar <- gets (.lastChar) for_ lchar $ guard . not . isSpace @@ -532,7 +534,7 @@ suscript = Marked "_^" $ try do plain = liftA2 (<>) sign $ withMContext (const True) isAlphaNum plainEnd - $ plainMarkupContext (withPos <$> entity <> latexFragment) + $ plainMarkupContext (mapMarkedP withPos $ entity <> latexFragment) plainEnd :: OrgParser () plainEnd = try do @@ -544,7 +546,7 @@ suscript = Marked "_^" $ try do -- * Macros -- | Parse a macro object. -macro :: Marked (OrgParser OrgObjectD) +macro :: Marked OrgParser OrgObjectD macro = Marked "{" $ try do _ <- string "{{{" _ <- lookAhead $ satisfy isAsciiAlpha @@ -561,7 +563,7 @@ macro = Marked "{" $ try do -- * Footnote references -- | Parse a footnote reference object. -footnoteReference :: Marked (OrgParser OrgObjectD) +footnoteReference :: Marked OrgParser OrgObjectD footnoteReference = Marked "[" $ withBalancedContext '[' ']' (const True) do _ <- string "fn:" lbl <- @@ -583,7 +585,7 @@ footnoteReference = Marked "[" $ withBalancedContext '[' ']' (const True) do -- * Timestamps -- | Parse a timestamp object. -timestamp :: Marked (OrgParser OrgObjectD) +timestamp :: Marked OrgParser OrgObjectD timestamp = Marked "<[" $ Timestamp <$> parseTimestamp -- | Parse a timestamp. @@ -640,7 +642,7 @@ parseTimestamp = try $ do -- * Statistic Cookies -- | Parse a statistic cookie object. -statisticCookie :: Marked (OrgParser OrgObjectD) +statisticCookie :: Marked OrgParser OrgObjectD statisticCookie = Marked "[" $ try do _ <- char '[' res <- Left <$> fra <|> Right <$> pct diff --git a/org-parser/src/Org/Types/Variants/ParseInfo.hs b/org-parser/src/Org/Types/Variants/ParseInfo.hs index be126e1..1b408ed 100644 --- a/org-parser/src/Org/Types/Variants/ParseInfo.hs +++ b/org-parser/src/Org/Types/Variants/ParseInfo.hs @@ -46,6 +46,12 @@ import Org.Types.Ix import Org.Types.Variants.Plain qualified as P data OrgF k ix = OrgF {props :: StandardProperties, datum :: P.OrgF k ix} + deriving (Generic) + +deriving instance (AllOrgIx Eq k) => (Eq (OrgF k a)) +deriving instance (AllOrgIx Ord k) => (Ord (OrgF k a)) +deriving instance (AllOrgIx Show k) => (Show (OrgF k a)) +deriving instance (AllOrgIx NFData k) => (NFData (OrgF k ix)) $(deriveGenericK ''OrgF) deriving via (Generically OrgF) instance (Endofunctor (~>) OrgF) diff --git a/org-parser/test/Tests/Document.hs b/org-parser/test/Tests/Document.hs index 72424e1..52e0f45 100644 --- a/org-parser/test/Tests/Document.hs +++ b/org-parser/test/Tests/Document.hs @@ -1,28 +1,24 @@ 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 - ] + goldenGroup + "document" + [ "property drawer" + ~: propertyDrawer + $ [ unlines + [ " :pRoPerTieS:" + , ":Fo^o3': \t bar" + , " :foobar:" + , ":fooBARbar: bla bla" + , " :ENd:" + ] + , unlines + [ ":properties" + , ":end:" + ] + ] ] diff --git a/org-parser/test/Tests/Elements.hs b/org-parser/test/Tests/Elements.hs index 0e3bfe0..d9312d8 100644 --- a/org-parser/test/Tests/Elements.hs +++ b/org-parser/test/Tests/Elements.hs @@ -1,108 +1,61 @@ 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 $ + goldenGroup + "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 $ + , "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" =!> () + , "comment line" ~: commentLine $ + [ "# this is a comment" + , "#this line is not a comment" ] - , "Paragraph" ~: elements $ + , "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 $ + , "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 @@ -111,43 +64,27 @@ testElements = #+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 $ + , "ordered lists" ~: plainList $ [ -- unlines [ "1. our" , "2. moment's" , "3. else's" ] - =?> B.orderedList OrderedNum '.' ["our", "moment's", "else's"] ] - , "Descriptive Lists" ~: plainList $ + , "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" + , "- :: :::" , "- /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 $ + , "lists in context" ~: elements $ [ -- unlines [ "- foo bar" @@ -155,26 +92,11 @@ testElements = , " #+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 [ "- " , " * " @@ -183,21 +105,6 @@ testElements = , " + " , "+" ] - =?> 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 [ "- " , "" @@ -210,69 +117,34 @@ testElements = , "" , " - 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 $ + , "greater blocks" ~: greaterBlock $ [ -- unlines [ "#+begin_fun" , " " , "#+end_fun" ] - =?> B.greaterBlock (Special "fun") mempty ] - , "Fixed width" ~: fixedWidth $ + , "fixed width" ~: fixedWidth $ [ -- [text| : fooblabla boo : foooo : booo |] - =?> B.example - mempty - [ SrcLine " fooblabla boo" - , SrcLine "foooo" - , SrcLine " booo" - ] ] - , "Horizontal Rules" ~: horizontalRule $ + , "horizontal rules" ~: horizontalRule $ [ "---------------- " - =?> B.horizontalRule , "-- " - =!> () ] - , "Tables" ~: table $ + , "tables" ~: table $ [ -- [text| | foo | bar | baz | @@ -282,19 +154,11 @@ testElements = | | 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") + , "tricky whitespace" ~: elements $ + [ "\n " + , "" + , "\n" + , "\n\n a" ] ] diff --git a/org-parser/test/Tests/Helpers.hs b/org-parser/test/Tests/Helpers.hs index c78f509..d133215 100644 --- a/org-parser/test/Tests/Helpers.hs +++ b/org-parser/test/Tests/Helpers.hs @@ -10,13 +10,18 @@ module Tests.Helpers ) where +import Data.Ix.RecursionSchemes (Fix (..)) import Data.TreeDiff -import Org.Builder (Many) +import Data.TreeDiff.Golden (ediffGolden) +import Data.TreeDiff.OMap qualified as OM import Org.Parser import Org.Parser.Objects (Marked (..)) -import Org.Types +import Org.Types.Variants.ParseInfo +import Org.Types.Variants.Plain qualified as P +import System.FilePath ((<.>), ()) import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty.Golden.Advanced +import Test.Tasty.Options import Text.Megaparsec (eof) import Text.Megaparsec.Error (errorBundlePretty) @@ -31,33 +36,13 @@ instance Parsable OrgParser where parse' p = parseOrg defaultOrgOptions (p <* eof) "" instance Parsable (Marked OrgParser) where - parse' p = parse' (getParser p) + parse' p = parse' p.parser -instance PrettyFormable Properties where - type PrettyForm Properties = Properties - prettyForm = id - -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, PrettyFormable a, ToExpr (PrettyForm a)) => m a -> Text -> IO () +prettyParse :: (Parsable m, ToExpr a) => m a -> Text -> IO () prettyParse parser txt = case parse' parser txt of Left e -> putStrLn $ errorBundlePretty e - Right x -> print $ ansiWlBgExpr $ toExpr $ prettyForm x + Right x -> print $ ansiWlBgExpr $ toExpr x infix 1 =?> @@ -69,65 +54,71 @@ 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, PrettyFormable a, Eq a, ToExpr (PrettyForm a)) => + (HasCallStack) => + (Parsable m, Eq a, ToExpr a) => TestName -> m a -> - [(Text, Either () a)] -> + [Text] -> 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 got - | Right reference <- ref -> - unless (got == reference) $ - assertFailure (diffExpr got reference) - | otherwise -> - assertFailure $ - "Should not parse, but parsed as:\n" <> renderExpr got + testGroup name + $ flip (`zipWith` [1 ..]) cases + $ \(i :: Int) txt -> + askOption \(GoldenPath outDir) -> + ediffGolden goldenTest (name <> " " <> show i) (outDir name <.> show i) + $ return + $ first errorBundlePretty + $ parse' parser txt + +newtype GoldenPath = GoldenPath String + +instance IsOption GoldenPath where + defaultValue = GoldenPath "test/files/golden" + parseValue = Just . GoldenPath + optionName = "golden-path" + optionHelp = "Path to golden test files." + +goldenGroup :: TestName -> [TestTree] -> TestTree +goldenGroup tn = adjustOption f . testGroup tn where - renderExpr :: (PrettyFormable a, ToExpr (PrettyForm a)) => a -> String - renderExpr = show . ansiWlBgExpr . toExpr . prettyForm - diffExpr :: (PrettyFormable a, ToExpr (PrettyForm a)) => a -> a -> String - diffExpr a b = show $ ansiWlBgEditExpr $ ediff (toExpr $ prettyForm a) (toExpr $ prettyForm b) + f (GoldenPath p) = GoldenPath (p tn) deriving instance (ToExpr OrgDocument) -deriving instance (ToExpr KeywordValue) -deriving instance (ToExpr OrgObject) +deriving instance (ToExpr (KeywordValue OrgObjects)) deriving instance (ToExpr QuoteType) deriving instance (ToExpr TimestampData) +deriving instance (ToExpr OrgDate) +deriving instance (ToExpr OrgTime) deriving instance (ToExpr FragmentType) -deriving instance (ToExpr FootnoteRefData) -deriving instance (ToExpr Citation) -deriving instance (ToExpr CiteReference) +deriving instance (ToExpr (FootnoteRefData OrgObjects)) +deriving instance (ToExpr (Citation OrgObjects)) +deriving instance (ToExpr (CiteReference OrgObjects)) deriving instance (ToExpr BabelCall) deriving instance (ToExpr LinkTarget) -deriving instance (ToExpr OrgElement) -deriving instance (ToExpr OrgElementData) +deriving instance (ToExpr (OrgElementData Org ix)) +deriving instance (ToExpr (OrgObjectData Org ix)) +deriving instance (ToExpr (OrgSectionData Org ix)) deriving instance (ToExpr GreaterBlockType) deriving instance (ToExpr ListType) deriving instance (ToExpr OrderedStyle) -deriving instance (ToExpr ListItem) +deriving instance (ToExpr (ListItem Org ix)) deriving instance (ToExpr Bullet) deriving instance (ToExpr Checkbox) -deriving instance (ToExpr SrcLine) -deriving instance (ToExpr TableRow) +deriving instance (ToExpr (TableRow OrgObjects)) deriving instance (ToExpr ColumnAlignment) -deriving instance (ToExpr OrgSection) +deriving instance (ToExpr (OrgF Org ix)) +deriving instance (ToExpr StandardProperties) deriving instance (ToExpr TodoKeyword) deriving instance (ToExpr TodoState) deriving instance (ToExpr Priority) deriving instance (ToExpr PlanningInfo) + +instance ToExpr (P.OrgF Org ix) where + toExpr = \case + P.OrgObjectF d -> toExpr d + P.OrgElementF a d -> Rec "OrgElement" (OM.fromList [("affiliated", toExpr a), ("data", toExpr d)]) + P.OrgSectionF d -> toExpr d + +instance ToExpr (Org ix) where + toExpr (Fix (ComposeIx x)) = Lst $ map toExpr $ toList x diff --git a/org-parser/test/Tests/Objects.hs b/org-parser/test/Tests/Objects.hs index b6d4419..3d62007 100644 --- a/org-parser/test/Tests/Objects.hs +++ b/org-parser/test/Tests/Objects.hs @@ -1,103 +1,78 @@ 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 $ + goldenGroup + "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 $ + , "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>>" =!> () + , "targets" ~: target $ + [ "<>" + , "<< not a target>>" + , "<>" + , "<>" + , "<>" + , "< is not a target>>" ] - , "Math fragment" ~: latexFragment $ - [ "\\(\\LaTeX + 2\\)" =?> B.inlMath "\\LaTeX + 2" - , "\\[\\LaTeX + 2\\]" =?> B.dispMath "\\LaTeX + 2" + , "math fragment" ~: latexFragment $ + [ "\\(\\LaTeX + 2\\)" + , "\\[\\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" + , "tex math fragments" ~: plainMarkupContext (mapMarkedP withPos texMathFragment) $ + [ "$e = mc^2$" + , "$$foo bar$" + , "$foo bar$a" + , "($foo bar$)" + , "This is $1 buck, not math ($1! so cheap!)" + , "two$$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") + , "subscripts and superscripts" ~: plainMarkupContext (mapMarkedP withPos suscript) $ + [ "not a _suscript" + , "not_{{suscript}" + , "a_{balanced^{crazy} ok}" + , "a_{balanced {suscript} ok}" + , "a_{bala\nnced {sus\ncript} ok}" + , "a^+strange,suscript," + , "a^*suspicious suscript" + , "a_bad,.,.,maleficent, one" + , "a_some\\LaTeX" ] - , "Line breaks" ~: plainMarkupContext linebreak $ + , "line breaks" ~: plainMarkupContext (mapMarkedP withPos linebreak) $ [ "this is a \\\\ \t\n\ \line break" - =?> "this is a " - <> B.linebreak - <> "line break" - , "also linebreak \\\\" =?> "also linebreak " <> B.linebreak + , "also 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") + , "image or links" ~: regularLink $ + [ "[[http://blablebli.com]]" + , "[[http://blablebli.com][/uh/ duh! *foo*]]" ] - , "Statistic Cookies" ~: statisticCookie $ - [ "[13/18]" =?> B.statisticCookie (Left (13, 18)) - , "[33%]" =?> B.statisticCookie (Right 33) + , "statistic cookies" ~: statisticCookie $ + [ "[13/18]" + , "[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" + , "footnote references" ~: footnoteReference $ + [ "[fn::simple]" + , "[fn::s[imple]" + , "[fn: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}"] + , "macros" ~: macro $ + [ "{{{fooo()}}}" + , "{{{função()}}}" + , "{{{2fun()}}}" + , "{{{fun-2_3(bar,(bar,baz){a})}}}" ] - , "Italic" ~: italic $ - [ "// foo/" =?> B.italic "/ foo" - , "/foo //" =?> B.italic "foo /" - , "/foo / f/" =?> B.italic "foo / f" + , "italic" ~: italic $ + [ "// foo/" + , "/foo //" + , "/foo / f/" ] ] diff --git a/org-parser/test/files/golden/document/property drawer.1 b/org-parser/test/files/golden/document/property drawer.1 new file mode 100644 index 0000000..f7fc297 --- /dev/null +++ b/org-parser/test/files/golden/document/property drawer.1 @@ -0,0 +1,6 @@ +Right + (Map.fromList + [ + _×_ "fo^o3'" "bar", + _×_ "foobar" "", + _×_ "foobarbar" "bla bla"]) diff --git a/org-parser/test/files/golden/document/property drawer.2 b/org-parser/test/files/golden/document/property drawer.2 new file mode 100644 index 0000000..d84a103 --- /dev/null +++ b/org-parser/test/files/golden/document/property drawer.2 @@ -0,0 +1,9 @@ +Left + (concat + [ + "1:1:\n", + " |\n", + "1 | :properties\n", + " | ^^^^^^^^^^^^\n", + "unexpected \":properties\"\n", + "expecting \":properties:\" or spaces or tabs\n"]) diff --git a/org-parser/test/files/golden/elements/affiliated keywords in context.1 b/org-parser/test/files/golden/elements/affiliated keywords in context.1 new file mode 100644 index 0000000..c9b0538 --- /dev/null +++ b/org-parser/test/files/golden/elements/affiliated keywords in context.1 @@ -0,0 +1,25 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 59, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList + [ + _×_ + "attr_html" + (BackendKeyword + [ + _×_ "width" "40px", + _×_ "foo" "bar:joined space", + _×_ "liz" "buuz"])], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 57, + end = 59, + postBlank = 0}, + datum = Plain "Hi"}]}}] diff --git a/org-parser/test/files/golden/elements/affiliated keywords in context.2 b/org-parser/test/files/golden/elements/affiliated keywords in context.2 new file mode 100644 index 0000000..b7b770b --- /dev/null +++ b/org-parser/test/files/golden/elements/affiliated keywords in context.2 @@ -0,0 +1,56 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 10, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 9, + postBlank = 0}, + datum = Plain "Some para"}]}}, + OrgF { + props = StandardProperties { + begin = 10, + end = 34, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList + [ + _×_ + "caption" + (ParsedKeyword + [ + OrgF { + props = StandardProperties { + begin = 31, + end = 34, + postBlank = 0}, + datum = Plain "hi "}, + OrgF { + props = StandardProperties { + begin = 34, + end = 40, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 35, + end = 38, + postBlank = 0}, + datum = Plain "guys"}]}])], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 32, + end = 34, + postBlank = 0}, + datum = Plain "Hi"}]}}] diff --git a/org-parser/test/files/golden/elements/affiliated keywords in context.3 b/org-parser/test/files/golden/elements/affiliated keywords in context.3 new file mode 100644 index 0000000..20b8b37 --- /dev/null +++ b/org-parser/test/files/golden/elements/affiliated keywords in context.3 @@ -0,0 +1,38 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 38, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList + [ + _×_ + "attr_html" + (BackendKeyword + [_×_ "style" "color: red"])], + data = PlainList + (Unordered '-') + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 35, + end = 38, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 35, + end = 38, + postBlank = 0}, + datum = Plain "foo"}]}}]}]}}] diff --git a/org-parser/test/files/golden/elements/affiliated keywords in context.4 b/org-parser/test/files/golden/elements/affiliated keywords in context.4 new file mode 100644 index 0000000..a3a4c8c --- /dev/null +++ b/org-parser/test/files/golden/elements/affiliated keywords in context.4 @@ -0,0 +1,56 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 10, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 9, + postBlank = 0}, + datum = Plain "Some para"}]}}, + OrgF { + props = StandardProperties { + begin = 10, + end = 33, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList + [ + _×_ + "caption" + (ParsedKeyword + [ + OrgF { + props = StandardProperties { + begin = 31, + end = 34, + postBlank = 0}, + datum = Plain "hi "}, + OrgF { + props = StandardProperties { + begin = 34, + end = 40, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 35, + end = 38, + postBlank = 0}, + datum = Plain "guys"}]}])], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 31, + end = 33, + postBlank = 0}, + datum = Plain "Hi"}]}}] diff --git a/org-parser/test/files/golden/elements/affiliated keywords in context.5 b/org-parser/test/files/golden/elements/affiliated keywords in context.5 new file mode 100644 index 0000000..4806451 --- /dev/null +++ b/org-parser/test/files/golden/elements/affiliated keywords in context.5 @@ -0,0 +1,89 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 80, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList + [ + _×_ + "attr_org" + (BackendKeyword + [_×_ "foo" "bar"])], + data = GreaterBlock + Center + [ + OrgF { + props = StandardProperties { + begin = 36, + end = 46, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 36, + end = 45, + postBlank = 0}, + datum = Plain "Some para"}]}}, + OrgF { + props = StandardProperties { + begin = 46, + end = 67, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Keyword + "caption" + (ParsedKeyword + [ + OrgF { + props = StandardProperties { + begin = 67, + end = 70, + postBlank = 0}, + datum = Plain "hi "}, + OrgF { + props = StandardProperties { + begin = 70, + end = 76, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 71, + end = 74, + postBlank = 0}, + datum = Plain "guys"}]}])}}]}}, + OrgF { + props = StandardProperties { + begin = 80, + end = 102, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 80, + end = 85, + postBlank = 0}, + datum = Plain "I don'"}, + OrgF { + props = StandardProperties { + begin = 86, + end = 95, + postBlank = 0}, + datum = Plain "t have a c"}, + OrgF { + props = StandardProperties { + begin = 96, + end = 102, + postBlank = 0}, + datum = Plain "aption"}]}}] diff --git a/org-parser/test/files/golden/elements/clock.1 b/org-parser/test/files/golden/elements/clock.1 new file mode 100644 index 0000000..3a592b1 --- /dev/null +++ b/org-parser/test/files/golden/elements/clock.1 @@ -0,0 +1,30 @@ +Right + (Clock + TimestampRange { + active = False, + start = _×_×_×_ + OrgDate { + year = 2012, + month = 11, + day = 18, + weekday = Just "Sun"} + (Just + OrgTime { + hour = 19, + minute = 26}) + Nothing + Nothing, + end = _×_×_×_ + OrgDate { + year = 2012, + month = 11, + day = 18, + weekday = Just "Sun"} + (Just + OrgTime { + hour = 19, + minute = 33}) + Nothing + Nothing} + (Just + OrgTime {hour = 0, minute = 7})) diff --git a/org-parser/test/files/golden/elements/clocks in context.1 b/org-parser/test/files/golden/elements/clocks in context.1 new file mode 100644 index 0000000..84c96f7 --- /dev/null +++ b/org-parser/test/files/golden/elements/clocks in context.1 @@ -0,0 +1,70 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 4, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 3, + postBlank = 0}, + datum = Plain "foo"}]}}, + OrgF { + props = StandardProperties { + begin = 4, + end = 67, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Clock + TimestampRange { + active = False, + start = _×_×_×_ + OrgDate { + year = 2012, + month = 11, + day = 18, + weekday = Just "Sun"} + (Just + OrgTime { + hour = 19, + minute = 26}) + Nothing + Nothing, + end = _×_×_×_ + OrgDate { + year = 2012, + month = 11, + day = 18, + weekday = Just "Sun"} + (Just + OrgTime { + hour = 19, + minute = 33}) + Nothing + Nothing} + (Just + OrgTime { + hour = 0, + minute = 7})}}, + OrgF { + props = StandardProperties { + begin = 67, + end = 70, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 67, + end = 70, + postBlank = 0}, + datum = Plain "bar"}]}}] diff --git a/org-parser/test/files/golden/elements/comment line.1 b/org-parser/test/files/golden/elements/comment line.1 new file mode 100644 index 0000000..6c4a43d --- /dev/null +++ b/org-parser/test/files/golden/elements/comment line.1 @@ -0,0 +1 @@ +Right Comment diff --git a/org-parser/test/files/golden/elements/comment line.2 b/org-parser/test/files/golden/elements/comment line.2 new file mode 100644 index 0000000..ea5e30b --- /dev/null +++ b/org-parser/test/files/golden/elements/comment line.2 @@ -0,0 +1,8 @@ +Left + (concat + [ + "1:2:\n", + " |\n", + "1 | #this line is not a comment\n", + " | ^\n", + "If this was meant as a comment, a space is missing here.\n"]) diff --git a/org-parser/test/files/golden/elements/descriptive lists.1 b/org-parser/test/files/golden/elements/descriptive lists.1 new file mode 100644 index 0000000..262e28b --- /dev/null +++ b/org-parser/test/files/golden/elements/descriptive lists.1 @@ -0,0 +1,32 @@ +Right + (PlainList + Descriptive + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Just + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 5, + postBlank = 0}, + datum = Plain "foo"}], + content = [ + OrgF { + props = StandardProperties { + begin = 11, + end = 14, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 11, + end = 14, + postBlank = 0}, + datum = Plain "bar"}]}}]}]) diff --git a/org-parser/test/files/golden/elements/descriptive lists.2 b/org-parser/test/files/golden/elements/descriptive lists.2 new file mode 100644 index 0000000..c24b429 --- /dev/null +++ b/org-parser/test/files/golden/elements/descriptive lists.2 @@ -0,0 +1,32 @@ +Right + (PlainList + Descriptive + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Just + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 9, + postBlank = 0}, + datum = Plain "foo bar"}], + content = [ + OrgF { + props = StandardProperties { + begin = 14, + end = 17, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 14, + end = 17, + postBlank = 0}, + datum = Plain "baz"}]}}]}]) diff --git a/org-parser/test/files/golden/elements/descriptive lists.3 b/org-parser/test/files/golden/elements/descriptive lists.3 new file mode 100644 index 0000000..8c07693 --- /dev/null +++ b/org-parser/test/files/golden/elements/descriptive lists.3 @@ -0,0 +1,17 @@ +Right + (PlainList + Descriptive + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Just + [ + OrgF { + props = StandardProperties { + begin = 4, + end = 6, + postBlank = 0}, + datum = Plain "::"}], + content = []}]) diff --git a/org-parser/test/files/golden/elements/descriptive lists.4 b/org-parser/test/files/golden/elements/descriptive lists.4 new file mode 100644 index 0000000..042f7c2 --- /dev/null +++ b/org-parser/test/files/golden/elements/descriptive lists.4 @@ -0,0 +1,17 @@ +Right + (PlainList + Descriptive + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Just + [ + OrgF { + props = StandardProperties { + begin = 4, + end = 10, + postBlank = 0}, + datum = Plain ":: foo"}], + content = []}]) diff --git a/org-parser/test/files/golden/elements/descriptive lists.5 b/org-parser/test/files/golden/elements/descriptive lists.5 new file mode 100644 index 0000000..88b1d21 --- /dev/null +++ b/org-parser/test/files/golden/elements/descriptive lists.5 @@ -0,0 +1,32 @@ +Right + (PlainList + Descriptive + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Just + [ + OrgF { + props = StandardProperties { + begin = 4, + end = 6, + postBlank = 0}, + datum = Plain "::"}], + content = [ + OrgF { + props = StandardProperties { + begin = 10, + end = 13, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 10, + end = 13, + postBlank = 0}, + datum = Plain "bar"}]}}]}]) diff --git a/org-parser/test/files/golden/elements/descriptive lists.6 b/org-parser/test/files/golden/elements/descriptive lists.6 new file mode 100644 index 0000000..d65bcb4 --- /dev/null +++ b/org-parser/test/files/golden/elements/descriptive lists.6 @@ -0,0 +1,25 @@ +Right + (PlainList + (Unordered '-') + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 3, + end = 10, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 3, + end = 10, + postBlank = 0}, + datum = Plain ":: :::"}]}}]}]) diff --git a/org-parser/test/files/golden/elements/descriptive lists.7 b/org-parser/test/files/golden/elements/descriptive lists.7 new file mode 100644 index 0000000..66d7541 --- /dev/null +++ b/org-parser/test/files/golden/elements/descriptive lists.7 @@ -0,0 +1,39 @@ +Right + (PlainList + Descriptive + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Just + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 7, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 3, + end = 6, + postBlank = 0}, + datum = Plain "foo"}]}], + content = [ + OrgF { + props = StandardProperties { + begin = 11, + end = 14, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 11, + end = 14, + postBlank = 0}, + datum = Plain "bar"}]}}]}]) diff --git a/org-parser/test/files/golden/elements/descriptive lists.8 b/org-parser/test/files/golden/elements/descriptive lists.8 new file mode 100644 index 0000000..ffada61 --- /dev/null +++ b/org-parser/test/files/golden/elements/descriptive lists.8 @@ -0,0 +1,40 @@ +Right + (PlainList + Descriptive + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Just + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 14, + postBlank = 0}, + datum = Link + (UnresolvedLink "foo") + [ + OrgF { + props = StandardProperties { + begin = 9, + end = 12, + postBlank = 0}, + datum = Plain "bar"}]}], + content = [ + OrgF { + props = StandardProperties { + begin = 18, + end = 21, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 18, + end = 21, + postBlank = 0}, + datum = Plain "bar"}]}}]}]) diff --git a/org-parser/test/files/golden/elements/descriptive lists.9 b/org-parser/test/files/golden/elements/descriptive lists.9 new file mode 100644 index 0000000..a79a1d5 --- /dev/null +++ b/org-parser/test/files/golden/elements/descriptive lists.9 @@ -0,0 +1,41 @@ +Right + (PlainList + Descriptive + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Just + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 26, + postBlank = 0}, + datum = Link + (URILink "foo" "prot.co") + [ + OrgF { + props = StandardProperties { + begin = 17, + end = 24, + postBlank = 0}, + datum = Plain "bar baz"}]}], + content = [ + OrgF { + props = StandardProperties { + begin = 30, + end = 40, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 30, + end = 40, + postBlank = 0}, + datum = Plain + "bla :: ble"}]}}]}]) diff --git a/org-parser/test/files/golden/elements/fixed width.1 b/org-parser/test/files/golden/elements/fixed width.1 new file mode 100644 index 0000000..e7ca500 --- /dev/null +++ b/org-parser/test/files/golden/elements/fixed width.1 @@ -0,0 +1,7 @@ +Right + (ExampleBlock + (Map.fromList []) + [ + " fooblabla boo", + "foooo", + " booo"]) diff --git a/org-parser/test/files/golden/elements/greater blocks.1 b/org-parser/test/files/golden/elements/greater blocks.1 new file mode 100644 index 0000000..9fd3018 --- /dev/null +++ b/org-parser/test/files/golden/elements/greater blocks.1 @@ -0,0 +1,4 @@ +Right + (GreaterBlock + (Special "fun") + []) diff --git a/org-parser/test/files/golden/elements/horizontal rules.1 b/org-parser/test/files/golden/elements/horizontal rules.1 new file mode 100644 index 0000000..2574d0e --- /dev/null +++ b/org-parser/test/files/golden/elements/horizontal rules.1 @@ -0,0 +1 @@ +Right HorizontalRule diff --git a/org-parser/test/files/golden/elements/horizontal rules.2 b/org-parser/test/files/golden/elements/horizontal rules.2 new file mode 100644 index 0000000..5fcfbf8 --- /dev/null +++ b/org-parser/test/files/golden/elements/horizontal rules.2 @@ -0,0 +1,8 @@ +Left + (concat + [ + "1:3:\n", + " |\n", + "1 | -- \n", + " | ^\n", + "expecting hrule dashes\n"]) diff --git a/org-parser/test/files/golden/elements/lists in context.1 b/org-parser/test/files/golden/elements/lists in context.1 new file mode 100644 index 0000000..18a3640 --- /dev/null +++ b/org-parser/test/files/golden/elements/lists in context.1 @@ -0,0 +1,65 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 28, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = PlainList + (Unordered '-') + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 2, + end = 10, + postBlank = 1}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 9, + postBlank = 0}, + datum = Plain "foo bar"}]}}, + OrgF { + props = StandardProperties { + begin = 13, + end = 28, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Keyword + "caption" + (ParsedKeyword + [ + OrgF { + props = StandardProperties { + begin = 28, + end = 31, + postBlank = 0}, + datum = Plain "foo"}])}}]}]}}, + OrgF { + props = StandardProperties { + begin = 28, + end = 32, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 28, + end = 31, + postBlank = 0}, + datum = Plain "bla"}]}}] diff --git a/org-parser/test/files/golden/elements/lists in context.2 b/org-parser/test/files/golden/elements/lists in context.2 new file mode 100644 index 0000000..1411dc6 --- /dev/null +++ b/org-parser/test/files/golden/elements/lists in context.2 @@ -0,0 +1,60 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 10, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = PlainList + (Unordered '-') + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 2, + end = 10, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 9, + postBlank = 0}, + datum = Plain + "foo bar"}]}}]}]}}, + OrgF { + props = StandardProperties { + begin = 10, + end = 31, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList + [ + _×_ + "caption" + (ParsedKeyword + [ + OrgF { + props = StandardProperties { + begin = 25, + end = 28, + postBlank = 0}, + datum = Plain "foo"}])], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 27, + end = 30, + postBlank = 0}, + datum = Plain "bla"}]}}] diff --git a/org-parser/test/files/golden/elements/lists in context.3 b/org-parser/test/files/golden/elements/lists in context.3 new file mode 100644 index 0000000..ac8a826 --- /dev/null +++ b/org-parser/test/files/golden/elements/lists in context.3 @@ -0,0 +1,73 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 23, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = PlainList + (Unordered '-') + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 3, + end = 21, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = PlainList + (Unordered '*') + [ + ListItem { + bullet = Bullet '*', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = []}, + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 10, + end = 14, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 10, + end = 13, + postBlank = 0}, + datum = Plain "foo"}]}}]}, + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = []}, + ListItem { + bullet = Bullet '+', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = []}]}}]}, + ListItem { + bullet = Bullet '+', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = []}]}}] diff --git a/org-parser/test/files/golden/elements/lists in context.4 b/org-parser/test/files/golden/elements/lists in context.4 new file mode 100644 index 0000000..84fff5c --- /dev/null +++ b/org-parser/test/files/golden/elements/lists in context.4 @@ -0,0 +1,107 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 10, + postBlank = 2}, + datum = OrgElement { + affiliated = Map.fromList [], + data = PlainList + (Unordered '-') + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = []}, + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 6, + end = 10, + postBlank = 2}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 6, + end = 9, + postBlank = 0}, + datum = Plain "foo"}]}}]}]}}, + OrgF { + props = StandardProperties { + begin = 16, + end = 26, + postBlank = 2}, + datum = OrgElement { + affiliated = Map.fromList [], + data = PlainList + (Unordered '*') + [ + ListItem { + bullet = Bullet '*', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 19, + end = 23, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 19, + end = 22, + postBlank = 0}, + datum = Plain "bar"}]}}]}, + ListItem { + bullet = Bullet '*', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = []}]}}, + OrgF { + props = StandardProperties { + begin = 28, + end = 35, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = PlainList + (Unordered '-') + [ + ListItem { + bullet = Bullet '-', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 31, + end = 35, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 31, + end = 34, + postBlank = 0}, + datum = Plain "doo"}]}}]}]}}] diff --git a/org-parser/test/files/golden/elements/lists in context.5 b/org-parser/test/files/golden/elements/lists in context.5 new file mode 100644 index 0000000..9623d86 --- /dev/null +++ b/org-parser/test/files/golden/elements/lists in context.5 @@ -0,0 +1,93 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 34, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = PlainList + (Ordered OrderedNum) + [ + ListItem { + bullet = Counter "1" '.', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 6, + end = 10, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 6, + end = 9, + postBlank = 0}, + datum = Plain "our"}]}}]}, + ListItem { + bullet = Counter "2" '.', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 14, + end = 23, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 14, + end = 20, + postBlank = 0}, + datum = Plain "moment'"}, + OrgF { + props = StandardProperties { + begin = 21, + end = 21, + postBlank = 0}, + datum = Plain "s"}]}}]}, + ListItem { + bullet = Counter "3" '.', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 27, + end = 34, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 27, + end = 29, + postBlank = 0}, + datum = Plain "els"}, + OrgF { + props = StandardProperties { + begin = 30, + end = 31, + postBlank = 0}, + datum = Plain "e'"}, + OrgF { + props = StandardProperties { + begin = 32, + end = 32, + postBlank = 0}, + datum = Plain "s"}]}}]}]}}] diff --git a/org-parser/test/files/golden/elements/ordered lists.1 b/org-parser/test/files/golden/elements/ordered lists.1 new file mode 100644 index 0000000..c7a8b6d --- /dev/null +++ b/org-parser/test/files/golden/elements/ordered lists.1 @@ -0,0 +1,85 @@ +Right + (PlainList + (Ordered OrderedNum) + [ + ListItem { + bullet = Counter "1" '.', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 3, + end = 7, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 3, + end = 6, + postBlank = 0}, + datum = Plain "our"}]}}]}, + ListItem { + bullet = Counter "2" '.', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 10, + end = 19, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 10, + end = 16, + postBlank = 0}, + datum = Plain "moment'"}, + OrgF { + props = StandardProperties { + begin = 17, + end = 17, + postBlank = 0}, + datum = Plain "s"}]}}]}, + ListItem { + bullet = Counter "3" '.', + counter = Nothing, + checkbox = Nothing, + tag = Nothing, + content = [ + OrgF { + props = StandardProperties { + begin = 22, + end = 29, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 22, + end = 24, + postBlank = 0}, + datum = Plain "els"}, + OrgF { + props = StandardProperties { + begin = 25, + end = 26, + postBlank = 0}, + datum = Plain "e'"}, + OrgF { + props = StandardProperties { + begin = 27, + end = 27, + postBlank = 0}, + datum = Plain "s"}]}}]}]) diff --git a/org-parser/test/files/golden/elements/paragraph.1 b/org-parser/test/files/golden/elements/paragraph.1 new file mode 100644 index 0000000..330b750 --- /dev/null +++ b/org-parser/test/files/golden/elements/paragraph.1 @@ -0,0 +1,19 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 10, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 10, + postBlank = 0}, + datum = Plain + (T.concat + ["foobar\n", "baz"])}]}}] diff --git a/org-parser/test/files/golden/elements/paragraph.2 b/org-parser/test/files/golden/elements/paragraph.2 new file mode 100644 index 0000000..40c9363 --- /dev/null +++ b/org-parser/test/files/golden/elements/paragraph.2 @@ -0,0 +1,107 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 87, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 5, + postBlank = 0}, + datum = Plain "with "}, + OrgF { + props = StandardProperties { + begin = 5, + end = 21, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 6, + end = 20, + postBlank = 0}, + datum = Plain + (T.concat + ["wrapped\n", "markup"])}]}, + OrgF { + props = StandardProperties { + begin = 21, + end = 33, + postBlank = 0}, + datum = Plain " and markup "}, + OrgF { + props = StandardProperties { + begin = 33, + end = 41, + postBlank = 0}, + datum = Bold + [ + OrgF { + props = StandardProperties { + begin = 34, + end = 40, + postBlank = 0}, + datum = Plain "at end"}]}, + OrgF { + props = StandardProperties { + begin = 41, + end = 42, + postBlank = 0}, + datum = Plain "\n"}, + OrgF { + props = StandardProperties { + begin = 42, + end = 52, + postBlank = 0}, + datum = Verbatim "at start"}, + OrgF { + props = StandardProperties { + begin = 52, + end = 60, + postBlank = 0}, + datum = Plain " but not~"}, + OrgF { + props = StandardProperties { + begin = 61, + end = 65, + postBlank = 0}, + datum = Plain "here~"}, + OrgF { + props = StandardProperties { + begin = 66, + end = 75, + postBlank = 0}, + datum = Plain + (T.concat [" and\n", "not _"])}, + OrgF { + props = StandardProperties { + begin = 76, + end = 80, + postBlank = 0}, + datum = Plain "here"}, + OrgF { + props = StandardProperties { + begin = 80, + end = 86, + postBlank = 0}, + datum = Subscript + [ + OrgF { + props = StandardProperties { + begin = 81, + end = 86, + postBlank = 0}, + datum = Plain "right"}]}, + OrgF { + props = StandardProperties { + begin = 86, + end = 87, + postBlank = 0}, + datum = Plain "."}]}}] diff --git a/org-parser/test/files/golden/elements/tables.1 b/org-parser/test/files/golden/elements/tables.1 new file mode 100644 index 0000000..ecc5c45 --- /dev/null +++ b/org-parser/test/files/golden/elements/tables.1 @@ -0,0 +1,123 @@ +Right + (Table + [ + StandardRow + [ + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 5, + postBlank = 0}, + datum = Plain "foo"}], + [ + OrgF { + props = StandardProperties { + begin = 8, + end = 11, + postBlank = 0}, + datum = Plain "bar"}], + [ + OrgF { + props = StandardProperties { + begin = 14, + end = 17, + postBlank = 0}, + datum = Plain "baz"}]], + StandardRow + [ + [ + OrgF { + props = StandardProperties { + begin = 25, + end = 32, + postBlank = 0}, + datum = Plain "foo bar"}], + [ + OrgF { + props = StandardProperties { + begin = 35, + end = 38, + postBlank = 0}, + datum = Plain "baz"}]], + RuleRow, + ColumnPropsRow + [ + Just AlignRight, + Nothing, + Just AlignLeft, + Just AlignCenter], + StandardRow + [ + [ + OrgF { + props = StandardProperties { + begin = 65, + end = 65, + postBlank = 0}, + datum = Plain "<"}, + OrgF { + props = StandardProperties { + begin = 66, + end = 68, + postBlank = 0}, + datum = Plain "r>"}], + [ + OrgF { + props = StandardProperties { + begin = 71, + end = 75, + postBlank = 0}, + datum = Plain "foo "}, + OrgF { + props = StandardProperties { + begin = 75, + end = 80, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 76, + end = 79, + postBlank = 0}, + datum = Plain "bar"}]}], + [ + OrgF { + props = StandardProperties { + begin = 83, + end = 87, + postBlank = 0}, + datum = Bold + [ + OrgF { + props = StandardProperties { + begin = 84, + end = 86, + postBlank = 0}, + datum = Plain "ba"}]}], + [ + OrgF { + props = StandardProperties { + begin = 90, + end = 93, + postBlank = 0}, + datum = Plain "baz"}]], + StandardRow + [ + [ + OrgF { + props = StandardProperties { + begin = 96, + end = 99, + postBlank = 0}, + datum = Plain "foo"}], + [], + [ + OrgF { + props = StandardProperties { + begin = 103, + end = 106, + postBlank = 0}, + datum = Plain "bar"}], + []]]) diff --git a/org-parser/test/files/golden/elements/tricky whitespace.1 b/org-parser/test/files/golden/elements/tricky whitespace.1 new file mode 100644 index 0000000..9fd3ca7 --- /dev/null +++ b/org-parser/test/files/golden/elements/tricky whitespace.1 @@ -0,0 +1 @@ +Right [] diff --git a/org-parser/test/files/golden/elements/tricky whitespace.2 b/org-parser/test/files/golden/elements/tricky whitespace.2 new file mode 100644 index 0000000..9fd3ca7 --- /dev/null +++ b/org-parser/test/files/golden/elements/tricky whitespace.2 @@ -0,0 +1 @@ +Right [] diff --git a/org-parser/test/files/golden/elements/tricky whitespace.3 b/org-parser/test/files/golden/elements/tricky whitespace.3 new file mode 100644 index 0000000..9fd3ca7 --- /dev/null +++ b/org-parser/test/files/golden/elements/tricky whitespace.3 @@ -0,0 +1 @@ +Right [] diff --git a/org-parser/test/files/golden/elements/tricky whitespace.4 b/org-parser/test/files/golden/elements/tricky whitespace.4 new file mode 100644 index 0000000..2073b97 --- /dev/null +++ b/org-parser/test/files/golden/elements/tricky whitespace.4 @@ -0,0 +1,17 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 4, + postBlank = 0}, + datum = OrgElement { + affiliated = Map.fromList [], + data = Paragraph + [ + OrgF { + props = StandardProperties { + begin = 3, + end = 4, + postBlank = 0}, + datum = Plain "a"}]}}] diff --git a/org-parser/test/files/golden/objects/citations.1 b/org-parser/test/files/golden/objects/citations.1 new file mode 100644 index 0000000..80a5420 --- /dev/null +++ b/org-parser/test/files/golden/objects/citations.1 @@ -0,0 +1,61 @@ +Right + (Cite + Citation { + style = "", + variant = "", + prefix = Just + [ + OrgF { + props = StandardProperties { + begin = 6, + end = 11, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 7, + end = 10, + postBlank = 0}, + datum = Plain "foo"}]}], + suffix = Just + [ + OrgF { + props = StandardProperties { + begin = 27, + end = 32, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 28, + end = 31, + postBlank = 0}, + datum = Plain "baz"}]}], + references = [ + CiteReference { + id = "bef", + prefix = Just + [ + OrgF { + props = StandardProperties { + begin = 12, + end = 17, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 13, + end = 16, + postBlank = 0}, + datum = Plain "bar"}]}], + suffix = Just + [ + OrgF { + props = StandardProperties { + begin = 21, + end = 26, + postBlank = 0}, + datum = Verbatim "bof"}]}]}) diff --git a/org-parser/test/files/golden/objects/footnote references.1 b/org-parser/test/files/golden/objects/footnote references.1 new file mode 100644 index 0000000..88eef7d --- /dev/null +++ b/org-parser/test/files/golden/objects/footnote references.1 @@ -0,0 +1,17 @@ +Right + (FootnoteRef + (FootnoteRefDef + Nothing + [ + OrgF { + props = StandardProperties { + begin = 5, + end = 5, + postBlank = 0}, + datum = Plain "s"}, + OrgF { + props = StandardProperties { + begin = 6, + end = 11, + postBlank = 0}, + datum = Plain "imple"}])) diff --git a/org-parser/test/files/golden/objects/footnote references.2 b/org-parser/test/files/golden/objects/footnote references.2 new file mode 100644 index 0000000..a1216b8 --- /dev/null +++ b/org-parser/test/files/golden/objects/footnote references.2 @@ -0,0 +1,9 @@ +Left + (concat + [ + "1:14:\n", + " |\n", + "1 | [fn::s[imple]\n", + " | ^\n", + "unexpected end of input\n", + "expecting balanced delimiters or insides of markup\n"]) diff --git a/org-parser/test/files/golden/objects/footnote references.3 b/org-parser/test/files/golden/objects/footnote references.3 new file mode 100644 index 0000000..c44cca8 --- /dev/null +++ b/org-parser/test/files/golden/objects/footnote references.3 @@ -0,0 +1,23 @@ +Right + (FootnoteRef + (FootnoteRefDef + (Just "mydef") + [ + OrgF { + props = StandardProperties { + begin = 10, + end = 10, + postBlank = 0}, + datum = Plain "s"}, + OrgF { + props = StandardProperties { + begin = 11, + end = 11, + postBlank = 0}, + datum = Plain "["}, + OrgF { + props = StandardProperties { + begin = 12, + end = 18, + postBlank = 0}, + datum = Plain "imp]le"}])) diff --git a/org-parser/test/files/golden/objects/image or links.1 b/org-parser/test/files/golden/objects/image or links.1 new file mode 100644 index 0000000..0c56ef3 --- /dev/null +++ b/org-parser/test/files/golden/objects/image or links.1 @@ -0,0 +1,6 @@ +Right + (Link + (URILink + "http" + "//blablebli.com") + []) diff --git a/org-parser/test/files/golden/objects/image or links.2 b/org-parser/test/files/golden/objects/image or links.2 new file mode 100644 index 0000000..5f746fc --- /dev/null +++ b/org-parser/test/files/golden/objects/image or links.2 @@ -0,0 +1,38 @@ +Right + (Link + (URILink + "http" + "//blablebli.com") + [ + OrgF { + props = StandardProperties { + begin = 24, + end = 28, + postBlank = 0}, + datum = Italic + [ + OrgF { + props = StandardProperties { + begin = 25, + end = 27, + postBlank = 0}, + datum = Plain "uh"}]}, + OrgF { + props = StandardProperties { + begin = 28, + end = 34, + postBlank = 0}, + datum = Plain " duh! "}, + OrgF { + props = StandardProperties { + begin = 34, + end = 39, + postBlank = 0}, + datum = Bold + [ + OrgF { + props = StandardProperties { + begin = 35, + end = 38, + postBlank = 0}, + datum = Plain "foo"}]}]) diff --git a/org-parser/test/files/golden/objects/italic.1 b/org-parser/test/files/golden/objects/italic.1 new file mode 100644 index 0000000..6c96c41 --- /dev/null +++ b/org-parser/test/files/golden/objects/italic.1 @@ -0,0 +1,15 @@ +Right + (Italic + [ + OrgF { + props = StandardProperties { + begin = 1, + end = 1, + postBlank = 0}, + datum = Plain "/"}, + OrgF { + props = StandardProperties { + begin = 2, + end = 6, + postBlank = 0}, + datum = Plain " foo"}]) diff --git a/org-parser/test/files/golden/objects/italic.2 b/org-parser/test/files/golden/objects/italic.2 new file mode 100644 index 0000000..c5064f3 --- /dev/null +++ b/org-parser/test/files/golden/objects/italic.2 @@ -0,0 +1,9 @@ +Right + (Italic + [ + OrgF { + props = StandardProperties { + begin = 1, + end = 5, + postBlank = 0}, + datum = Plain "foo /"}]) diff --git a/org-parser/test/files/golden/objects/italic.3 b/org-parser/test/files/golden/objects/italic.3 new file mode 100644 index 0000000..f080922 --- /dev/null +++ b/org-parser/test/files/golden/objects/italic.3 @@ -0,0 +1,15 @@ +Right + (Italic + [ + OrgF { + props = StandardProperties { + begin = 1, + end = 5, + postBlank = 0}, + datum = Plain "foo /"}, + OrgF { + props = StandardProperties { + begin = 6, + end = 8, + postBlank = 0}, + datum = Plain " f"}]) diff --git a/org-parser/test/files/golden/objects/line breaks.1 b/org-parser/test/files/golden/objects/line breaks.1 new file mode 100644 index 0000000..763c35a --- /dev/null +++ b/org-parser/test/files/golden/objects/line breaks.1 @@ -0,0 +1,20 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 10, + postBlank = 0}, + datum = Plain "this is a "}, + OrgF { + props = StandardProperties { + begin = 10, + end = 16, + postBlank = 0}, + datum = LineBreak}, + OrgF { + props = StandardProperties { + begin = 16, + end = 26, + postBlank = 0}, + datum = Plain "line break"}] diff --git a/org-parser/test/files/golden/objects/line breaks.2 b/org-parser/test/files/golden/objects/line breaks.2 new file mode 100644 index 0000000..4114efc --- /dev/null +++ b/org-parser/test/files/golden/objects/line breaks.2 @@ -0,0 +1,15 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 15, + postBlank = 0}, + datum = Plain + "also linebreak "}, + OrgF { + props = StandardProperties { + begin = 15, + end = 17, + postBlank = 0}, + datum = LineBreak}] diff --git a/org-parser/test/files/golden/objects/macros.1 b/org-parser/test/files/golden/objects/macros.1 new file mode 100644 index 0000000..d7c45d5 --- /dev/null +++ b/org-parser/test/files/golden/objects/macros.1 @@ -0,0 +1 @@ +Right (Macro "fooo" [""]) diff --git a/org-parser/test/files/golden/objects/macros.2 b/org-parser/test/files/golden/objects/macros.2 new file mode 100644 index 0000000..175701a --- /dev/null +++ b/org-parser/test/files/golden/objects/macros.2 @@ -0,0 +1,9 @@ +Left + (concat + [ + "1:7:\n", + " |\n", + "1 | {{{fun\231\227o()}}}\n", + " | ^^^\n", + "unexpected \"\231\227o\"\n", + "expecting \"}}}\" or '('\n"]) diff --git a/org-parser/test/files/golden/objects/macros.3 b/org-parser/test/files/golden/objects/macros.3 new file mode 100644 index 0000000..52e50db --- /dev/null +++ b/org-parser/test/files/golden/objects/macros.3 @@ -0,0 +1,8 @@ +Left + (concat + [ + "1:4:\n", + " |\n", + "1 | {{{2fun()}}}\n", + " | ^\n", + "unexpected '2'\n"]) diff --git a/org-parser/test/files/golden/objects/macros.4 b/org-parser/test/files/golden/objects/macros.4 new file mode 100644 index 0000000..7cfe8ee --- /dev/null +++ b/org-parser/test/files/golden/objects/macros.4 @@ -0,0 +1,4 @@ +Right + (Macro + "fun-2_3" + ["bar", "(bar", "baz){a}"]) diff --git a/org-parser/test/files/golden/objects/math fragment.1 b/org-parser/test/files/golden/objects/math fragment.1 new file mode 100644 index 0000000..849a54d --- /dev/null +++ b/org-parser/test/files/golden/objects/math fragment.1 @@ -0,0 +1,4 @@ +Right + (LaTeXFragment + InlMathFragment + "\\LaTeX + 2") diff --git a/org-parser/test/files/golden/objects/math fragment.2 b/org-parser/test/files/golden/objects/math fragment.2 new file mode 100644 index 0000000..2bb8a83 --- /dev/null +++ b/org-parser/test/files/golden/objects/math fragment.2 @@ -0,0 +1,4 @@ +Right + (LaTeXFragment + DispMathFragment + "\\LaTeX + 2") diff --git a/org-parser/test/files/golden/objects/statistic cookies.1 b/org-parser/test/files/golden/objects/statistic cookies.1 new file mode 100644 index 0000000..ef6013d --- /dev/null +++ b/org-parser/test/files/golden/objects/statistic cookies.1 @@ -0,0 +1,3 @@ +Right + (StatisticCookie + (Left (_×_ 13 18))) diff --git a/org-parser/test/files/golden/objects/statistic cookies.2 b/org-parser/test/files/golden/objects/statistic cookies.2 new file mode 100644 index 0000000..a879609 --- /dev/null +++ b/org-parser/test/files/golden/objects/statistic cookies.2 @@ -0,0 +1,2 @@ +Right + (StatisticCookie (Right 33)) diff --git a/org-parser/test/files/golden/objects/subscripts and superscripts.1 b/org-parser/test/files/golden/objects/subscripts and superscripts.1 new file mode 100644 index 0000000..83187cd --- /dev/null +++ b/org-parser/test/files/golden/objects/subscripts and superscripts.1 @@ -0,0 +1,14 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 6, + postBlank = 0}, + datum = Plain "not a _"}, + OrgF { + props = StandardProperties { + begin = 7, + end = 15, + postBlank = 0}, + datum = Plain "suscript"}] diff --git a/org-parser/test/files/golden/objects/subscripts and superscripts.2 b/org-parser/test/files/golden/objects/subscripts and superscripts.2 new file mode 100644 index 0000000..b9beb95 --- /dev/null +++ b/org-parser/test/files/golden/objects/subscripts and superscripts.2 @@ -0,0 +1,14 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 3, + postBlank = 0}, + datum = Plain "not_"}, + OrgF { + props = StandardProperties { + begin = 4, + end = 15, + postBlank = 0}, + datum = Plain "{{suscript}"}] diff --git a/org-parser/test/files/golden/objects/subscripts and superscripts.3 b/org-parser/test/files/golden/objects/subscripts and superscripts.3 new file mode 100644 index 0000000..de05e12 --- /dev/null +++ b/org-parser/test/files/golden/objects/subscripts and superscripts.3 @@ -0,0 +1,40 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 1, + postBlank = 0}, + datum = Plain "a"}, + OrgF { + props = StandardProperties { + begin = 1, + end = 23, + postBlank = 0}, + datum = Subscript + [ + OrgF { + props = StandardProperties { + begin = 3, + end = 11, + postBlank = 0}, + datum = Plain "balanced"}, + OrgF { + props = StandardProperties { + begin = 11, + end = 19, + postBlank = 0}, + datum = Superscript + [ + OrgF { + props = StandardProperties { + begin = 13, + end = 18, + postBlank = 0}, + datum = Plain "crazy"}]}, + OrgF { + props = StandardProperties { + begin = 19, + end = 22, + postBlank = 0}, + datum = Plain " ok"}]}] diff --git a/org-parser/test/files/golden/objects/subscripts and superscripts.4 b/org-parser/test/files/golden/objects/subscripts and superscripts.4 new file mode 100644 index 0000000..0ce8108 --- /dev/null +++ b/org-parser/test/files/golden/objects/subscripts and superscripts.4 @@ -0,0 +1,27 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 1, + postBlank = 0}, + datum = Plain "a"}, + OrgF { + props = StandardProperties { + begin = 1, + end = 26, + postBlank = 0}, + datum = Subscript + [ + OrgF { + props = StandardProperties { + begin = 3, + end = 12, + postBlank = 0}, + datum = Plain "balanced {"}, + OrgF { + props = StandardProperties { + begin = 13, + end = 25, + postBlank = 0}, + datum = Plain "suscript} ok"}]}] diff --git a/org-parser/test/files/golden/objects/subscripts and superscripts.5 b/org-parser/test/files/golden/objects/subscripts and superscripts.5 new file mode 100644 index 0000000..99eada3 --- /dev/null +++ b/org-parser/test/files/golden/objects/subscripts and superscripts.5 @@ -0,0 +1,31 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 1, + postBlank = 0}, + datum = Plain "a"}, + OrgF { + props = StandardProperties { + begin = 1, + end = 28, + postBlank = 0}, + datum = Subscript + [ + OrgF { + props = StandardProperties { + begin = 3, + end = 13, + postBlank = 0}, + datum = Plain + (T.concat + ["bala\n", "nced {"])}, + OrgF { + props = StandardProperties { + begin = 14, + end = 27, + postBlank = 0}, + datum = Plain + (T.concat + ["sus\n", "cript} ok"])}]}] diff --git a/org-parser/test/files/golden/objects/subscripts and superscripts.6 b/org-parser/test/files/golden/objects/subscripts and superscripts.6 new file mode 100644 index 0000000..ca5aa49 --- /dev/null +++ b/org-parser/test/files/golden/objects/subscripts and superscripts.6 @@ -0,0 +1,28 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 1, + postBlank = 0}, + datum = Plain "a"}, + OrgF { + props = StandardProperties { + begin = 1, + end = 19, + postBlank = 0}, + datum = Superscript + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 19, + postBlank = 0}, + datum = Plain + "+strange,suscript"}]}, + OrgF { + props = StandardProperties { + begin = 19, + end = 20, + postBlank = 0}, + datum = Plain ","}] diff --git a/org-parser/test/files/golden/objects/subscripts and superscripts.7 b/org-parser/test/files/golden/objects/subscripts and superscripts.7 new file mode 100644 index 0000000..7ed11be --- /dev/null +++ b/org-parser/test/files/golden/objects/subscripts and superscripts.7 @@ -0,0 +1,28 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 1, + postBlank = 0}, + datum = Plain "a"}, + OrgF { + props = StandardProperties { + begin = 1, + end = 3, + postBlank = 0}, + datum = Superscript + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 3, + postBlank = 0}, + datum = Plain "*"}]}, + OrgF { + props = StandardProperties { + begin = 3, + end = 22, + postBlank = 0}, + datum = Plain + "suspicious suscript"}] diff --git a/org-parser/test/files/golden/objects/subscripts and superscripts.8 b/org-parser/test/files/golden/objects/subscripts and superscripts.8 new file mode 100644 index 0000000..ed93460 --- /dev/null +++ b/org-parser/test/files/golden/objects/subscripts and superscripts.8 @@ -0,0 +1,28 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 1, + postBlank = 0}, + datum = Plain "a"}, + OrgF { + props = StandardProperties { + begin = 1, + end = 20, + postBlank = 0}, + datum = Subscript + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 20, + postBlank = 0}, + datum = Plain + "bad,.,.,maleficent"}]}, + OrgF { + props = StandardProperties { + begin = 20, + end = 25, + postBlank = 0}, + datum = Plain ", one"}] diff --git a/org-parser/test/files/golden/objects/subscripts and superscripts.9 b/org-parser/test/files/golden/objects/subscripts and superscripts.9 new file mode 100644 index 0000000..43d09ad --- /dev/null +++ b/org-parser/test/files/golden/objects/subscripts and superscripts.9 @@ -0,0 +1,29 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 1, + postBlank = 0}, + datum = Plain "a"}, + OrgF { + props = StandardProperties { + begin = 1, + end = 12, + postBlank = 0}, + datum = Subscript + [ + OrgF { + props = StandardProperties { + begin = 2, + end = 6, + postBlank = 0}, + datum = Plain "some"}, + OrgF { + props = StandardProperties { + begin = 6, + end = 12, + postBlank = 0}, + datum = LaTeXFragment + RawFragment + "\\LaTeX"}]}] diff --git a/org-parser/test/files/golden/objects/targets.1 b/org-parser/test/files/golden/objects/targets.1 new file mode 100644 index 0000000..714f372 --- /dev/null +++ b/org-parser/test/files/golden/objects/targets.1 @@ -0,0 +1,2 @@ +Right + (Target "this is a target") diff --git a/org-parser/test/files/golden/objects/targets.2 b/org-parser/test/files/golden/objects/targets.2 new file mode 100644 index 0000000..b8846a6 --- /dev/null +++ b/org-parser/test/files/golden/objects/targets.2 @@ -0,0 +1,8 @@ +Left + (concat + [ + "1:16:\n", + " |\n", + "1 | << not a target>>\n", + " | ^\n", + "expecting dedicated target\n"]) diff --git a/org-parser/test/files/golden/objects/targets.3 b/org-parser/test/files/golden/objects/targets.3 new file mode 100644 index 0000000..2913aac --- /dev/null +++ b/org-parser/test/files/golden/objects/targets.3 @@ -0,0 +1,8 @@ +Left + (concat + [ + "1:16:\n", + " |\n", + "1 | <>\n", + " | ^\n", + "expecting dedicated target\n"]) diff --git a/org-parser/test/files/golden/objects/targets.4 b/org-parser/test/files/golden/objects/targets.4 new file mode 100644 index 0000000..cc99679 --- /dev/null +++ b/org-parser/test/files/golden/objects/targets.4 @@ -0,0 +1,8 @@ +Left + (concat + [ + "1:8:\n", + " |\n", + "1 | <>\n", + " | ^\n", + "expecting dedicated target\n"]) diff --git a/org-parser/test/files/golden/objects/targets.5 b/org-parser/test/files/golden/objects/targets.5 new file mode 100644 index 0000000..b9804d5 --- /dev/null +++ b/org-parser/test/files/golden/objects/targets.5 @@ -0,0 +1,8 @@ +Left + (concat + [ + "1:8:\n", + " |\n", + "1 | < is not a target>>\n", + " | ^\n", + "expecting dedicated target\n"]) diff --git a/org-parser/test/files/golden/objects/tex math fragments.1 b/org-parser/test/files/golden/objects/tex math fragments.1 new file mode 100644 index 0000000..1a382e2 --- /dev/null +++ b/org-parser/test/files/golden/objects/tex math fragments.1 @@ -0,0 +1,10 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 10, + postBlank = 0}, + datum = LaTeXFragment + InlMathFragment + "e = mc^2"}] diff --git a/org-parser/test/files/golden/objects/tex math fragments.2 b/org-parser/test/files/golden/objects/tex math fragments.2 new file mode 100644 index 0000000..58cc051 --- /dev/null +++ b/org-parser/test/files/golden/objects/tex math fragments.2 @@ -0,0 +1,20 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 0, + postBlank = 0}, + datum = Plain "$"}, + OrgF { + props = StandardProperties { + begin = 1, + end = 1, + postBlank = 0}, + datum = Plain "$"}, + OrgF { + props = StandardProperties { + begin = 2, + end = 9, + postBlank = 0}, + datum = Plain "foo bar$"}] diff --git a/org-parser/test/files/golden/objects/tex math fragments.3 b/org-parser/test/files/golden/objects/tex math fragments.3 new file mode 100644 index 0000000..cdf1770 --- /dev/null +++ b/org-parser/test/files/golden/objects/tex math fragments.3 @@ -0,0 +1,20 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 0, + postBlank = 0}, + datum = Plain "$"}, + OrgF { + props = StandardProperties { + begin = 1, + end = 8, + postBlank = 0}, + datum = Plain "foo bar$"}, + OrgF { + props = StandardProperties { + begin = 9, + end = 10, + postBlank = 0}, + datum = Plain "a"}] diff --git a/org-parser/test/files/golden/objects/tex math fragments.4 b/org-parser/test/files/golden/objects/tex math fragments.4 new file mode 100644 index 0000000..10a78ca --- /dev/null +++ b/org-parser/test/files/golden/objects/tex math fragments.4 @@ -0,0 +1,22 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 1, + postBlank = 0}, + datum = Plain "("}, + OrgF { + props = StandardProperties { + begin = 1, + end = 10, + postBlank = 0}, + datum = LaTeXFragment + InlMathFragment + "foo bar"}, + OrgF { + props = StandardProperties { + begin = 10, + end = 11, + postBlank = 0}, + datum = Plain ")"}] diff --git a/org-parser/test/files/golden/objects/tex math fragments.5 b/org-parser/test/files/golden/objects/tex math fragments.5 new file mode 100644 index 0000000..b744a7a --- /dev/null +++ b/org-parser/test/files/golden/objects/tex math fragments.5 @@ -0,0 +1,21 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 8, + postBlank = 0}, + datum = Plain "This is $"}, + OrgF { + props = StandardProperties { + begin = 9, + end = 27, + postBlank = 0}, + datum = Plain + "1 buck, not math ($"}, + OrgF { + props = StandardProperties { + begin = 28, + end = 41, + postBlank = 0}, + datum = Plain "1! so cheap!)"}] diff --git a/org-parser/test/files/golden/objects/tex math fragments.6 b/org-parser/test/files/golden/objects/tex math fragments.6 new file mode 100644 index 0000000..7f9c297 --- /dev/null +++ b/org-parser/test/files/golden/objects/tex math fragments.6 @@ -0,0 +1,22 @@ +Right + [ + OrgF { + props = StandardProperties { + begin = 0, + end = 3, + postBlank = 0}, + datum = Plain "two"}, + OrgF { + props = StandardProperties { + begin = 3, + end = 19, + postBlank = 0}, + datum = LaTeXFragment + DispMathFragment + "always means"}, + OrgF { + props = StandardProperties { + begin = 19, + end = 23, + postBlank = 0}, + datum = Plain "math"}] diff --git a/org-parser/test/files/golden/objects/timestamp.1 b/org-parser/test/files/golden/objects/timestamp.1 new file mode 100644 index 0000000..311ff31 --- /dev/null +++ b/org-parser/test/files/golden/objects/timestamp.1 @@ -0,0 +1,16 @@ +Right + (Timestamp + TimestampData { + active = True, + time = _×_×_×_ + OrgDate { + year = 1997, + month = 11, + day = 3, + weekday = Just "Mon"} + (Just + OrgTime { + hour = 19, + minute = 15}) + Nothing + Nothing}) diff --git a/org-parser/test/files/golden/objects/timestamp.2 b/org-parser/test/files/golden/objects/timestamp.2 new file mode 100644 index 0000000..0b157a4 --- /dev/null +++ b/org-parser/test/files/golden/objects/timestamp.2 @@ -0,0 +1,16 @@ +Right + (Timestamp + TimestampData { + active = False, + time = _×_×_×_ + OrgDate { + year = 2020, + month = 3, + day = 4, + weekday = Nothing} + (Just + OrgTime { + hour = 20, + minute = 20}) + Nothing + Nothing}) diff --git a/org-parser/test/files/golden/objects/timestamp.3 b/org-parser/test/files/golden/objects/timestamp.3 new file mode 100644 index 0000000..30b9290 --- /dev/null +++ b/org-parser/test/files/golden/objects/timestamp.3 @@ -0,0 +1,14 @@ +Right + (Timestamp + TimestampData { + active = False, + time = _×_×_×_ + OrgDate { + year = 2020, + month = 3, + day = 4, + weekday = Nothing} + (Just + OrgTime {hour = 0, minute = 20}) + Nothing + Nothing})