add --run command with sh support

2 files changed, 69 insertions, 1 deletions

diff --git a/mdblocks.cabal b/mdblocks.cabal
index 67eddf3..e29d9bd 100644
--- a/mdblocks.cabal
+++ b/mdblocks.cabal
@@ -16,6 +16,7 @@ executable mdblocks
     , directory
     , filepath
     , optparse-applicative
+    , process
     , text
 
   default-language: Haskell2010
diff --git a/src/MdBlocks/CLI.hs b/src/MdBlocks/CLI.hs
index 3849220..5c28765 100644
--- a/src/MdBlocks/CLI.hs
+++ b/src/MdBlocks/CLI.hs
@@ -5,8 +5,10 @@ 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 qualified Data.Text as T
 import System.Directory (doesFileExist)
-import System.Exit (die)
+import System.Exit (ExitCode(ExitFailure, ExitSuccess), die, exitWith)
+import System.Process (createProcess, proc, waitForProcess)
 
 import Options.Applicative
 
@@ -18,6 +20,7 @@ import MdBlocks.Types
 data Command
   = List FilePath
   | Extract String
+  | Run String [String]
   | ShowMeta String
 
 runCLI :: IO ()
@@ -33,6 +36,7 @@ parser :: Parser Command
 parser =
       listP
   <|> extractP
+  <|> runP
   <|> showP
 
 listP :: Parser Command
@@ -51,6 +55,16 @@ extractP =
     <> help "Extract a block by its address"
     )
 
+runP :: Parser Command
+runP =
+  Run
+    <$> strOption
+      ( long "run"
+      <> metavar "FILE#ID"
+      <> help "Run a code block by its address"
+      )
+    <*> many (argument str (metavar "ARG..."))
+
 showP :: Parser Command
 showP =
   ShowMeta <$> strOption
@@ -87,6 +101,27 @@ run (Extract rawAddress) =
             Right block ->
               T.putStr (blockContent block)
 
+run (Run rawAddress args) =
+  case parseAddress rawAddress of
+    Left err ->
+      die ("mdblocks: " ++ err)
+
+    Right address -> do
+      isFile <- doesFileExist (addressFile address)
+
+      if not isFile
+        then
+          die ("mdblocks: not a file: " ++ addressFile address)
+        else do
+          blocks <- loadBlocks (addressFile address)
+
+          case resolveBlock address blocks of
+            Left err ->
+              die ("mdblocks: " ++ formatResolveError address err)
+
+            Right block ->
+              runBlock rawAddress block args
+
 run (ShowMeta addr) =
   putStrLn ("show not implemented yet: " ++ addr)
 
@@ -95,3 +130,35 @@ loadBlocks :: FilePath -> IO [Block]
 loadBlocks fp = do
   txt <- T.readFile fp
   pure (parseFile fp txt)
+
+
+runBlock :: String -> Block -> [String] -> IO ()
+runBlock rawAddress block args =
+  case mdLanguage (blockMeta block) of
+    Just "sh" ->
+      runSh rawAddress block args
+
+    Just language ->
+      die $
+        "mdblocks: no interpreter for language: "
+          ++ T.unpack language
+
+    Nothing ->
+      die "mdblocks: block has no language"
+
+
+runSh :: String -> Block -> [String] -> IO ()
+runSh rawAddress block args = do
+  (_, _, _, processHandle) <-
+    createProcess $
+      proc "/bin/sh"
+        (["-c", T.unpack (blockContent block), rawAddress] ++ args)
+
+  exitCode <- waitForProcess processHandle
+
+  case exitCode of
+    ExitSuccess ->
+      pure ()
+
+    ExitFailure code ->
+      exitWith (ExitFailure code)