diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog +## 2.1.0 (2023-04-19) + +#### Changed + +- Support numbered lists. + ## 2.0.2 (2022-07-31) #### Changed diff --git a/lib/Data/Org.hs b/lib/Data/Org.hs --- a/lib/Data/Org.hs +++ b/lib/Data/Org.hs @@ -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 diff --git a/org-mode.cabal b/org-mode.cabal --- a/org-mode.cabal +++ b/org-mode.cabal @@ -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 diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -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 ] ) diff --git a/test/test.org b/test/test.org --- a/test/test.org +++ b/test/test.org @@ -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 |