blob: 94dbae6ba4b0022ac8d5b7b2f76ea365db165691 (
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
|
{-# 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 Options.Applicative
import MdBlocks.Address
import MdBlocks.Repository
import MdBlocks.Resolver
import MdBlocks.Types
data Command
= List FilePath
| Extract 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
<|> 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"
)
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 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
|
