packages feed

org-mode 2.0.2 → 2.1.0

raw patch · 5 files changed

+123/−58 lines, 5 files

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # Changelog +## 2.1.0 (2023-04-19)++#### Changed++- Support numbered lists.+ ## 2.0.2 (2022-07-31)  #### Changed
lib/Data/Org.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE DeriveAnyClass     #-} {-# LANGUAGE DeriveGeneric      #-} {-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE TupleSections      #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}  -- | -- Module    : Data.Org@@ -38,6 +40,7 @@   , Block(..)   , Words(..)   , ListItems(..)+  , ListType(..)   , Item(..)   , Row(..)   , Column(..)@@ -70,6 +73,7 @@ import           Control.Applicative.Combinators.NonEmpty import           Control.Monad (void, when) import           Data.Bool (bool)+import           Data.Char (isDigit) import           Data.Functor (($>)) import           Data.Hashable (Hashable) import           Data.List.NonEmpty (NonEmpty(..))@@ -87,8 +91,8 @@ import           System.FilePath (takeExtension) import           Text.Megaparsec hiding (sepBy1, sepEndBy1, some, someTill) import           Text.Megaparsec.Char-import           Text.Megaparsec.Char.Lexer (decimal) import qualified Text.Megaparsec.Char.Lexer as L+import           Text.Megaparsec.Char.Lexer (decimal) import           Text.Printf (printf)  --------------------------------------------------------------------------------@@ -279,20 +283,23 @@ newtype Priority = Priority { priority :: Text }   deriving stock (Eq, Ord, Show, Generic) --- | An org list constructed of @-@ characters.+-- | An org list constructed of @-@ or @+@ characters, or numbers. -- -- @--- - Feed the cat---   - The good stuff--- - Feed the dog---   - He'll eat anything--- - Feed the bird--- - Feed the alligator--- - Feed the elephant+-- 1. Feed the cat+--    - The good stuff+-- 2. Feed the dog+--    - He'll eat anything+-- 3. Feed the bird+-- 4. Feed the alligator+-- 5. Feed the elephant -- @-newtype ListItems = ListItems (NonEmpty Item)+data ListItems = ListItems ListType (NonEmpty Item)   deriving stock (Eq, Ord, Show, Generic) +data ListType = Bulleted | Plussed | Numbered+  deriving stock (Eq, Ord, Show, Generic)+ -- | A line in a bullet-list. Can contain sublists, as shown in `ListItems`. data Item = Item (NonEmpty Words) (Maybe ListItems)   deriving stock (Eq, Ord, Show, Generic)@@ -516,37 +523,55 @@     lng = char ' '  *> someTillEnd  list :: Parser Block-list = L.lexeme space $ List <$> listItems 0+list = L.lexeme space . fmap List $ itemChoice 0 -listItems :: Int -> Parser ListItems-listItems indent = ListItems-  <$> sepBy1 (item indent) (try $ newline *> lookAhead (nextItem indent))+itemChoice :: Int -> Parser ListItems+itemChoice indent = bulleted+ indent <|> starred indent <|> numbered indent -nextItem :: Int -> Parser ()-nextItem indent = do-  void . string $ T.replicate indent " "-  void $ string "- "+bulleted :: Int -> Parser ListItems+bulleted+ indent = ListItems Bulleted <$> listItems (string "- ") indent +starred :: Int -> Parser ListItems+starred indent = ListItems Plussed <$> listItems (string "+ ") indent++numbered :: Int -> Parser ListItems+numbered indent = ListItems Numbered <$> listItems numd indent+  where+    numd = (decimal :: Parser Word) *> string ". "++listItems :: Parser a -> Int -> Parser (NonEmpty Item)+listItems tick indent = sepBy1 (item tick indent) $ try next+  where+    next = newline *> lookAhead (nextItem tick indent)++nextItem :: Parser a -> Int -> Parser a+nextItem tick indent = string (T.replicate indent " ") *> tick+ -- | Conditions for ending the current bullet: -- -- 1. You find two '\n' at the end of a line.--- 2. The first two non-space characters of the next line are "- ".-item :: Int -> Parser Item-item indent = do-  leading <- string $ T.replicate indent " "-  void $ string "- "-  l <- bullet-  let !nextInd = T.length leading + 2-  Item l <$> optional (try $ newline *> listItems nextInd)+-- 2. The first two non-space characters of the next line mark the start of a point, like "- ".+item :: Parser a -> Int -> Parser Item+item tick indent = do+  void . string $ T.replicate indent " "+  void tick+  l <- content+  let !nextInd = indent + 2+  Item l <$> optional (try $ newline *> itemChoice nextInd)   where-    bullet :: Parser (NonEmpty Words)-    bullet = do+    content :: Parser (NonEmpty Words)+    content = do       l <- line '\n'-      try (lookAhead keepGoing *> space *> ((l <>) <$> bullet)) <|> pure l+      try (lookAhead keepGoing *> space *> ((l <>) <$> content)) <|> pure l      keepGoing :: Parser ()-    keepGoing = void $ char '\n' *> manyOf ' ' *> noneOf ['-', '\n']+    keepGoing = void $ char '\n' *> manyOf ' ' *> satisfy notItem +    notItem :: Char -> Bool+    notItem c = c /= '\n' && c /= '-' && c /= '+' && not (isDigit c)+ table :: Parser Block table = L.lexeme space $ Table <$> sepEndBy1 row (char '\n')   where@@ -758,6 +783,7 @@   Month -> "m"   Year  -> "y" +-- | Render a `Block` into the original text form it was parsed from (or equivalent). prettyBlock :: Block -> Text prettyBlock o = case o of   Code l t -> "#+begin_src" <> maybe "" (\(Language l') -> " " <> l' <> "\n") l@@ -765,21 +791,41 @@     <> "\n#+end_src"   Quote t -> "#+begin_quote\n" <> t <> "\n#+end_quote"   Example t -> "#+begin_example\n" <> t <> "\n#+end_example"-  Paragraph ht -> par ht-  List items -> lis 0 items+  Paragraph ht -> prettyWordGroups ht+  List items -> prettyList items   Table rows -> T.intercalate "\n" . map row $ NEL.toList rows   where-    lis :: Int -> ListItems -> Text-    lis indent (ListItems is) = T.intercalate "\n" . map (f indent) $ NEL.toList is+    row :: Row -> Text+    row Break    = "|-|"+    row (Row cs) = "| " <> (T.intercalate " | " . map col $ NEL.toList cs) <> " |" -    f :: Int -> Item -> Text-    f indent (Item ws li) =-      T.replicate indent " " <> "- " <> par ws-      <> maybe "" (\is -> "\n" <> lis (indent + 2) is) li+    col :: Column -> Text+    col Empty       = ""+    col (Column ws) = T.unwords . map prettyWords $ NEL.toList ws -    par :: NonEmpty Words -> Text-    par (h :| t) = prettyWords h <> para h t+prettyList :: ListItems -> Text+prettyList = T.unlines . prettyListWork 0 +prettyListWork :: Int -> ListItems -> [Text]+prettyListWork indent (ListItems t is) = concatMap (uncurry prettyItem) . relabel $ NEL.toList is+  where+    relabel :: [Item] -> [(Text, Item)]+    relabel = case t of+      Bulleted -> map ("-",)+      Plussed  -> map ("+",)+      Numbered -> zipWith (\n i -> (tshow n <> ".", i)) ([1..] :: [Int])++    prettyItem :: Text -> Item -> [Text]+    prettyItem lbl (Item ws sub) = real : maybe [] (prettyListWork $ succ indent) sub+      where+        real = prefix <> lbl <> " " <> prettyWordGroups ws++    prefix :: Text+    prefix = T.replicate (2 * indent) " "++prettyWordGroups :: NonEmpty Words -> Text+prettyWordGroups (h :| t) = prettyWords h <> para h t+  where     -- | Stick punctuation directly behind the chars in front of it, while     -- paying special attention to parentheses.     para :: Words -> [Words] -> Text@@ -791,14 +837,6 @@         Punct _   -> prettyWords w <> para w ws         _         -> " " <> prettyWords w <> para w ws -    row :: Row -> Text-    row Break    = "|-|"-    row (Row cs) = "| " <> (T.intercalate " | " . map col $ NEL.toList cs) <> " |"--    col :: Column -> Text-    col Empty       = ""-    col (Column ws) = T.unwords . map prettyWords $ NEL.toList ws- prettyWords :: Words -> Text prettyWords w = case w of   Bold t                  -> "*" <> t <> "*"@@ -812,3 +850,6 @@   Image (URL url)         -> "[[" <> url <> "]]"   Punct c                 -> T.singleton c   Plain t                 -> t++tshow :: Show a => a -> Text+tshow = T.pack . show
org-mode.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               org-mode-version:            2.0.2+version:            2.1.0 synopsis:           Parser for Emacs org-mode files. description:        Parser for Emacs org-mode files. category:           Data
test/Test.hs view
@@ -284,33 +284,33 @@       , testCase "List - Single Indent"       $ testPretty list "List" "- A\n  - B"-      $ List (ListItems [Item [Plain "A"] (Just $ ListItems [Item [Plain "B"] Nothing])])+      $ List (ListItems Bulleted [Item [Plain "A"] (Just $ ListItems Bulleted [Item [Plain "B"] Nothing])])      , testCase "List - Indent and Back"       $ testPretty list "List" "- A\n  - B\n- C"-      $ List (ListItems-               [ Item [Plain "A"] (Just $ ListItems [Item [Plain "B"] Nothing])+      $ List (ListItems Bulleted+               [ Item [Plain "A"] (Just $ ListItems Bulleted [Item [Plain "B"] Nothing])                , Item [Plain "C"] Nothing ])      , testCase "List - Double Indent and Back"       $ testPretty list "List" "- A\n  - B\n  - C\n- D"-      $ List (ListItems-               [ Item [Plain "A"] (Just $ ListItems [Item [Plain "B"] Nothing, Item [Plain "C"] Nothing])+      $ List (ListItems Bulleted+               [ Item [Plain "A"] (Just $ ListItems Bulleted [Item [Plain "B"] Nothing, Item [Plain "C"] Nothing])                , Item [Plain "D"] Nothing ])      , testCase "List - Things after" $ parseMaybe orgP "- A\n  - B\n- C\n\nD"-      @?= Just (OrgDoc [ List (ListItems-                               [ Item [Plain "A"] (Just $ ListItems [Item [Plain "B"] Nothing])+      @?= Just (OrgDoc [ List (ListItems Bulleted+                               [ Item [Plain "A"] (Just $ ListItems Bulleted [Item [Plain "B"] Nothing])                                , Item [Plain "C"] Nothing])                        , Paragraph [Plain "D"]] [])      , testCase "List - Multiline"       $ testPretty list "List" "- A\n  B\n- C"-      $ List (ListItems [Item [Plain "A", Plain "B"] Nothing, Item [Plain "C"] Nothing])+      $ List (ListItems Bulleted [Item [Plain "A", Plain "B"] Nothing, Item [Plain "C"] Nothing])      , testCase "List - Special Parens"       $ testPretty list "List" "- The [[https://github.com/kadena-io/chainweb-node][A]] (core developer)\n- B"-      $ List (ListItems+      $ List (ListItems Bulleted               [ Item [Plain "The", Link (URL "https://github.com/kadena-io/chainweb-node") (Just "A"), Punct '(', Plain "core", Plain "developer)"] Nothing               , Item [Plain "B"] Nothing ]              )
test/test.org view
@@ -91,6 +91,24 @@ - Mapbox VectorTile codecs ([[https://github.com/fosskers/vectortiles][Haskell]], [[https://github.com/locationtech/geotrellis/tree/master/vectortile][Scala]]) - [[https://github.com/fosskers/scalaz-and-cats][ScalaZ and Cats Comparison]] and the [[https://github.com/fosskers/scala-benchmarks][Scala Collections Benchmarks]] +* List with numbers++1. Meditate.+2. ???+3. Reach Nirvana.++** Irritating List++1. First thing.+   - Sub point.+     1. But+     2. And+     3. Further+   - Another thing.+2. Second thing.+3. Third thing.+   - But did you consider this?+ * Some Tables  | A | B | C |