blob: bd2bc738bbdfe90d0a891de30e5ad1a45dc804c3 (
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
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
import qualified Data.Aeson
import Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy.Char8
import Data.MIME.Extended
import qualified Options.Applicative
import qualified System.Exit
import System.IO (hPutStrLn,stderr)
data Options = Options
{ optionDecode :: Bool
, optionInputFile :: String
, optionOutputFile :: String
}
optionsParser :: Options.Applicative.Parser Options
optionsParser =
Options
<$> Options.Applicative.switch
( Options.Applicative.long "decode"
<> Options.Applicative.short 'd'
<> Options.Applicative.help "Decode JSON to IMF"
)
<*> Options.Applicative.strOption
( Options.Applicative.long "input"
<> Options.Applicative.short 'i'
<> Options.Applicative.help "File to read."
<> Options.Applicative.value "-"
<> Options.Applicative.metavar "PATH"
)
<*> Options.Applicative.strOption
( Options.Applicative.long "output"
<> Options.Applicative.short 'o'
<> Options.Applicative.help "File to write."
<> Options.Applicative.value "-"
<> Options.Applicative.metavar "PATH"
)
newtype MIMENoTweak = MIMENoTweak MIME
instance RenderMessage MIMENoTweak where
buildBody h (MIMENoTweak b) = buildBody h b
main :: IO ()
main = do
options <-
Options.Applicative.execParser $
Options.Applicative.info optionsParser Options.Applicative.briefDesc
let input =
case optionInputFile options of
"-" ->
Data.ByteString.Lazy.Char8.getContents
path ->
Data.ByteString.Lazy.Char8.readFile path
output =
case optionOutputFile options of
"-" ->
Data.ByteString.Lazy.Char8.putStrLn
path ->
Data.ByteString.Lazy.Char8.writeFile path
s <- input
if optionDecode options then
case Data.Aeson.decode s :: Maybe MIMEMessage of
Just (Message h b) ->
output $ renderMessage (Message h (MIMENoTweak b))
Nothing -> do
hPutStrLn stderr "error: failed to decode MIME message"
System.Exit.exitFailure
else
case parse (message mime) s of
Right mail ->
output $ encodePretty' conf mail
Left err -> do
hPutStrLn stderr $ "error: " <> err
System.Exit.exitFailure
where
conf =
defConfig
{ confCompare = keyOrder ["headers","body"] `mappend` compare
, confIndent = Spaces 2
}
|
