summaryrefslogtreecommitdiffstats
path: root/src/main.hs
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
        }