summaryrefslogtreecommitdiffstats
path: root/src/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/main.hs')
-rw-r--r--src/main.hs95
1 files changed, 95 insertions, 0 deletions
diff --git a/src/main.hs b/src/main.hs
new file mode 100644
index 0000000..bd2bc73
--- /dev/null
+++ b/src/main.hs
@@ -0,0 +1,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
+ }