implement --extract

3 files changed, 141 insertions, 7 deletions

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