diff options
| -rw-r--r-- | mdblocks.cabal | 2 | ||||
| -rw-r--r-- | src/MdBlocks/Address.hs | 28 | ||||
| -rw-r--r-- | src/MdBlocks/CLI.hs | 65 | ||||
| -rw-r--r-- | src/MdBlocks/Resolver.hs | 55 |
4 files changed, 143 insertions, 7 deletions
diff --git a/mdblocks.cabal b/mdblocks.cabal index 55034d7..80c73b7 100644 --- a/mdblocks.cabal +++ b/mdblocks.cabal @@ -23,8 +23,10 @@ executable mdblocks ghc-options: -Wall other-modules: + MdBlocks.Address MdBlocks.CLI MdBlocks.Metadata MdBlocks.Parser MdBlocks.Repository + MdBlocks.Resolver MdBlocks.Types diff --git a/src/MdBlocks/Address.hs b/src/MdBlocks/Address.hs index c3dc5a4..8a32e0f 100644 --- a/src/MdBlocks/Address.hs +++ b/src/MdBlocks/Address.hs @@ -1,12 +1,38 @@ {-# LANGUAGE OverloadedStrings #-} -module MdBlocks.Address where +module MdBlocks.Address + ( Address(..) + , parseAddress + , addressOf + ) +where import Data.Text (Text) import qualified Data.Text as T import MdBlocks.Types +data Address + = GlobalId Text + | FileAddress FilePath Text + deriving (Show, Eq) + +parseAddress :: String -> Either String Address +parseAddress input = + case T.breakOn "#" (T.pack input) of + (file, ident) + | T.null file -> + Left "address must contain a file path" + + | T.null ident -> + Left "address must contain a block id after '#'" + + | otherwise -> + Right + (FileAddress + (T.unpack file) + (T.drop 1 ident)) + addressOf :: Block -> Text addressOf b = case mdId (blockMeta b) of diff --git a/src/MdBlocks/CLI.hs b/src/MdBlocks/CLI.hs index 96a3193..94dbae6 100644 --- a/src/MdBlocks/CLI.hs +++ b/src/MdBlocks/CLI.hs @@ -4,10 +4,14 @@ module MdBlocks.CLI where import qualified Data.Aeson.Encode.Pretty as JSON import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.Text.IO as T import Options.Applicative +import MdBlocks.Address import MdBlocks.Repository +import MdBlocks.Resolver +import MdBlocks.Types data Command = List FilePath @@ -18,7 +22,10 @@ runCLI :: IO () runCLI = execParser opts >>= run where - opts = info parser mempty + opts = + info + (parser <**> helper) + (fullDesc <> progDesc "Parse and extract Markdown blocks") parser :: Parser Command parser = @@ -29,17 +36,26 @@ parser = listP :: Parser Command listP = List <$> strOption - (long "file") + ( long "list" + <> metavar "FILE" + <> help "List blocks in a Markdown file" + ) extractP :: Parser Command extractP = Extract <$> strOption - (long "extract") + ( long "extract" + <> metavar "FILE#ID" + <> help "Extract a block by its address" + ) showP :: Parser Command showP = ShowMeta <$> strOption - (long "show") + ( long "show" + <> metavar "FILE#ID" + <> help "Show block metadata" + ) run :: Command -> IO () @@ -48,8 +64,45 @@ run (List fp) = do BL.putStrLn $ JSON.encodePretty bs -run (Extract addr) = - putStrLn ("extract not implemented yet: " ++ addr) +run (Extract rawAddr) = + case parseAddress rawAddr of + Left err -> + failWith err + + Right addr -> + extractBlock addr run (ShowMeta addr) = putStrLn ("show not implemented yet: " ++ addr) + +extractBlock :: Address -> IO () +extractBlock addr = do + let fp = + case addr of + FileAddress file _ -> + file + + GlobalId _ -> + error "global block addresses are not supported by --extract" + + blocks <- loadBlocks fp + + case resolveBlock addr blocks of + Nothing -> + failWith + ("block not found: " ++ showAddress addr) + + Just block -> + T.putStr (blockContent block) + +failWith :: String -> IO () +failWith msg = do + putStrLn ("mdblocks: " ++ msg) + fail msg + +showAddress :: Address -> String +showAddress (GlobalId ident) = + "#" ++ show ident + +showAddress (FileAddress fp ident) = + fp ++ "#" ++ show ident diff --git a/src/MdBlocks/Resolver.hs b/src/MdBlocks/Resolver.hs new file mode 100644 index 0000000..c6e94d1 --- /dev/null +++ b/src/MdBlocks/Resolver.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} + +module MdBlocks.Resolver + ( resolveBlock + ) +where + +import Data.Text (Text) + +import MdBlocks.Address +import MdBlocks.Types + +resolveBlock + :: Address + -> [Block] + -> Maybe Block + +resolveBlock (GlobalId ident) blocks = + findById ident blocks + +resolveBlock (FileAddress fp ident) blocks = + findByFileAndId fp ident blocks + +findById :: Text -> [Block] -> Maybe Block +findById ident = + go + where + go [] = + Nothing + + go (b:bs) + | mdId (blockMeta b) == Just ident = + Just b + + | otherwise = + go bs + +findByFileAndId + :: FilePath + -> Text + -> [Block] + -> Maybe Block +findByFileAndId fp ident = + go + where + go [] = + Nothing + + go (b:bs) + | blockFile b == fp + , mdId (blockMeta b) == Just ident = + Just b + + | otherwise = + go bs |