1 files changed, 59 insertions, 6 deletions
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