blob: 5c28765b9eb7f84a10c85b1d721e8cd250e98abf (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
{-# LANGUAGE OverloadedStrings #-}
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 (ExitCode(ExitFailure, ExitSuccess), die, exitWith)
import System.Process (createProcess, proc, waitForProcess)
import Options.Applicative
import MdBlocks.Address
import MdBlocks.Parser
import MdBlocks.Resolver
import MdBlocks.Types
data Command
= List FilePath
| Extract String
| Run String [String]
| ShowMeta String
runCLI :: IO ()
runCLI =
execParser opts >>= run
where
opts =
info
(parser <**> helper)
(fullDesc <> progDesc "Parse and extract Markdown blocks")
parser :: Parser Command
parser =
listP
<|> extractP
<|> runP
<|> showP
listP :: Parser Command
listP =
List <$> strOption
( long "list"
<> metavar "FILE"
<> help "List blocks in a Markdown file"
)
extractP :: Parser Command
extractP =
Extract <$> strOption
( long "extract"
<> metavar "FILE#ID"
<> 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
( long "show"
<> metavar "FILE#ID"
<> help "Show block metadata"
)
run :: Command -> IO ()
run (List fp) = do
bs <- loadBlocks fp
BL.putStrLn $
JSON.encodePretty bs
run (Extract rawAddress) =
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 ->
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)
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)
|
