Skip to content

Commit

Permalink
markdown: Remove constraint on header level bump
Browse files Browse the repository at this point in the history
Allow going to header levels in increments greater than 1. I think this
was an artificial restriction which e.g. disallows trying out nested
pieces of config stand-alone.
  • Loading branch information
myme committed May 9, 2024
1 parent 1efc9b0 commit ddc643c
Show file tree
Hide file tree
Showing 2 changed files with 26 additions and 21 deletions.
31 changes: 10 additions & 21 deletions src/Nixon/Config/Markdown.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

module Nixon.Config.Markdown
Expand All @@ -12,7 +13,6 @@ where
import CMark (commonmarkToNode)
import qualified CMark as M
import qualified Data.Aeson as Aeson
import qualified Data.Yaml as Yaml
import Data.Bifunctor (Bifunctor (bimap, first))
import Data.Char (isSpace)
import Data.Either (partitionEithers)
Expand All @@ -23,6 +23,7 @@ import Data.Text (pack, strip)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Tuple (swap)
import qualified Data.Yaml as Yaml
import Nixon.Command (bg, json, (<!))
import qualified Nixon.Command as Cmd
import qualified Nixon.Command.Placeholder as Cmd
Expand All @@ -49,7 +50,6 @@ import Text.Parsec.Text (Parser)
import Text.Read (readMaybe)
import Turtle
( IsString (fromString),
d,
format,
s,
w,
Expand All @@ -62,7 +62,7 @@ data PosInfo = PosInfo
posLocation :: Maybe M.PosInfo
}

defaultPath :: MonadIO m => m FilePath
defaultPath :: (MonadIO m) => m FilePath
defaultPath = liftIO $ fromString <$> getXdgDirectory XdgConfig "nixon.md"

buildConfig :: (JSON.Config, [Cmd.Command]) -> Config
Expand Down Expand Up @@ -166,23 +166,14 @@ parse :: FilePath -> [Node] -> Either Text (JSON.Config, [Cmd.Command])
parse fileName nodes = bimap (fromMaybe JSON.empty) reverse <$> go (S 0 []) (Nothing, []) nodes
where
go _ ps [] = Right ps
go st ps nodes'@(Head _ l name _ : _)
go st ps nodes'@(Head _ l _ _ : _)
-- Going back up or next sibling
| l < stateHeaderLevel st = go (S l []) ps nodes'
-- Skipping levels on the way down
| l > stateHeaderLevel st + 1 =
Left $
format
("Unexpected header level bump (" % d % " to " % d % "): " % s)
(stateHeaderLevel st)
l
name
| l < st.stateHeaderLevel = go (S l []) ps nodes'
go st (cfg, ps) (Head pos l name attrs : rest)
-- We found a config
| hasArgs "config" attrs = case parseConfig rest of
(Left err, _) -> Left err
(Right cfg', rest') -> goWithSingleConfig st (cfg, ps) rest' cfg'

-- We found a command
| hasArgs "command" attrs =
let pt = getKwargs "type" attrs <> stateProjectTypes st
Expand All @@ -191,7 +182,6 @@ parse fileName nodes = bimap (fromMaybe JSON.empty) reverse <$> go (S 0 []) (Not
in case parseCommand (PosInfo fileName pos) name pt rest of
(Left err, _) -> Left err
(Right p, rest') -> go st (cfg, p <! bg isBg <! json isJson : ps) rest'

-- Pick up project type along the way
| otherwise = go st' (cfg, ps) rest
where
Expand All @@ -209,7 +199,6 @@ parse fileName nodes = bimap (fromMaybe JSON.empty) reverse <$> go (S 0 []) (Not
| "config" `elem` attrs = case parseConfig (Source lang attrs src : rest) of
(Left err, _) -> Left err
(Right cfg', rest') -> goWithSingleConfig st (cfg, ps) rest' cfg'

-- All other nodes are ignored
go st ps (_ : rest) = go st ps rest

Expand Down Expand Up @@ -259,11 +248,11 @@ parseCommand pos name projectTypes (Source lang attrs src : rest) = (cmd, rest)
parsedSourceArgs <- first (T.pack . show) $ P.parse parseCommandArgs "" (T.unwords attrs)
if not (null args) && not (null parsedSourceArgs)
then
Left $
withPosition pos $
format
(s % " uses placeholders in both command header and source code block")
name'
Left
$ withPosition pos
$ format
(s % " uses placeholders in both command header and source code block")
name'
else
pure
Cmd.empty
Expand Down
16 changes: 16 additions & 0 deletions test/Test/Nixon/Config/Markdown.hs
Original file line number Diff line number Diff line change
Expand Up @@ -241,6 +241,22 @@ command_tests = describe "commands section" $ do
selector = fmap (Cmd.cmdName &&& Cmd.cmdIsHidden) . Cfg.commands
in selector <$> result `shouldBe` Right [("_hidden", True)]

it "can bump header level gaps (0 -> 2, 2 -> 4)" $
let result =
parseMarkdown "some-file.md" $
T.unlines
[ "## `hello`",
"```bash",
"echo Hello World",
"```",
"#### `world`",
"```bash",
"echo World",
"```"
]
selector = fmap Cmd.cmdName . Cfg.commands
in selector <$> result `shouldBe` Right ["hello", "world"]

it "command name is first word" $
let result =
parseMarkdown "some-file.md" $
Expand Down

0 comments on commit ddc643c

Please sign in to comment.