agitprop: file magic

[fd/haskell-amqp-utils.git] / Network / AMQP / Utils / Options.hs

diff --git a/Network/AMQP/Utils/Options.hs b/Network/AMQP/Utils/Options.hs
index 6458483701e2fa0da1a9fbe5a062c7396da53752..cc819fdbe64dcf97e6ddc4919c7fdcb38a0be012 100644 (file)
--- a/Network/AMQP/Utils/Options.hs
+++ b/Network/AMQP/Utils/Options.hs
@@ -1,8 +1,8 @@
 module Network.AMQP.Utils.Options where
 
 import Data.Default.Class
-import Data.Maybe
 import qualified Data.Map as M
+import Data.Maybe
 import Data.Text (Text, pack)
 import Data.Version (showVersion)
 import Network.AMQP.Types
@@ -34,20 +34,21 @@ data Args = Args
   , inputFile :: String
   , lineMode :: Bool
   , confirm :: Bool
-  , msgtimestamp :: Maybe Timestamp
   , msgid :: Maybe Text
   , msgtype :: Maybe Text
-  , msguserid :: Maybe Text
-  , msgappid :: Maybe Text
-  , msgclusterid :: Maybe Text
-  , msgcontenttype :: Maybe Text
-  , msgcontentencoding :: Maybe Text
-  , msgreplyto :: Maybe Text
-  , msgprio :: Maybe Octet
-  , msgcorrid :: Maybe Text
+  , userid :: Maybe Text
+  , appid :: Maybe Text
+  , clusterid :: Maybe Text
+  , contenttype :: Maybe Text
+  , contentencoding :: Maybe Text
+  , replyto :: Maybe Text
+  , prio :: Maybe Octet
+  , corrid :: Maybe Text
   , msgexp :: Maybe Text
   , msgheader :: Maybe FieldTable
-  , fnheader :: [ String ]
+  , fnheader :: [String]
+  , suffix :: [String]
+  , magic :: Bool
   }
 
 instance Default Args where
@@ -88,8 +89,9 @@ instance Default Args where
       Nothing
       Nothing
       Nothing
-      Nothing
       []
+      []
+      False
 
 -- | Common options
 cOptions :: [OptDescr (Args -> Args)]
@@ -228,78 +230,81 @@ aOptions =
       ["confirm"]
       (NoArg (\o -> o {confirm = not (confirm o)}))
       ("Toggle confirms (default: " ++ show (confirm def) ++ ")")
-  , Option
-      []
-      ["msgtimestamp"]
-      (ReqArg (\s o -> o {msgtimestamp = Just $ read s}) "TIMESTAMP")
-      ("Message Timestamp")
   , Option
       []
       ["msgid"]
       (ReqArg (\s o -> o {msgid = Just $ pack s}) "ID")
-      ("Message ID")
+      "Message ID"
   , Option
       []
-      ["msgtype"]
+      ["type"]
       (ReqArg (\s o -> o {msgtype = Just $ pack s}) "TYPE")
-      ("Message Type")
+      "Message Type"
   , Option
       []
-      ["msguserid"]
-      (ReqArg (\s o -> o {msguserid = Just $ pack s}) "USERID")
-      ("Message UserID")
+      ["userid"]
+      (ReqArg (\s o -> o {userid = Just $ pack s}) "USERID")
+      "Message User-ID"
   , Option
       []
-      ["msgappid"]
-      (ReqArg (\s o -> o {msgappid = Just $ pack s}) "APPID")
-      ("Message ApplicationID")
+      ["appid"]
+      (ReqArg (\s o -> o {appid = Just $ pack s}) "APPID")
+      "Message App-ID"
   , Option
       []
-      ["msgclusterid"]
-      (ReqArg (\s o -> o {msgclusterid = Just $ pack s}) "CLUSTERID")
-      ("Message ClusterID")
+      ["clusterid"]
+      (ReqArg (\s o -> o {clusterid = Just $ pack s}) "CLUSTERID")
+      "Message Cluster-ID"
   , Option
       []
-      ["msgcontenttype"]
-      (ReqArg (\s o -> o {msgcontenttype = Just $ pack s}) "CONTENTTYPE")
-      ("Message ContentType")
+      ["contenttype"]
+      (ReqArg (\s o -> o {contenttype = Just $ pack s}) "CONTENTTYPE")
+      "Message Content-Type"
   , Option
       []
-      ["msgcontentencoding"]
-      (ReqArg
-         (\s o -> o {msgcontentencoding = Just $ pack s})
-         "CONTENTENCODING")
-      ("Message ContentEncoding")
+      ["contentencoding"]
+      (ReqArg (\s o -> o {contentencoding = Just $ pack s}) "CONTENTENCODING")
+      "Message Content-Encoding"
   , Option
       []
-      ["msgreplyto"]
-      (ReqArg (\s o -> o {msgreplyto = Just $ pack s}) "REPLYTO")
-      ("Message ReplyTo")
+      ["replyto"]
+      (ReqArg (\s o -> o {replyto = Just $ pack s}) "REPLYTO")
+      "Message Reply-To"
   , Option
       []
-      ["msgprio"]
-      (ReqArg (\s o -> o {msgprio = Just $ read s}) "PRIO")
-      ("Message Priority")
+      ["prio"]
+      (ReqArg (\s o -> o {prio = Just $ read s}) "PRIO")
+      "Message Priority"
   , Option
       []
-      ["msgcorrid"]
-      (ReqArg (\s o -> o {msgcorrid = Just $ pack s}) "CORRID")
-      ("Message CorrelationID")
+      ["corrid"]
+      (ReqArg (\s o -> o {corrid = Just $ pack s}) "CORRID")
+      "Message CorrelationID"
   , Option
       []
-      ["msgexp"]
+      ["exp"]
       (ReqArg (\s o -> o {msgexp = Just $ pack s}) "EXP")
-      ("Message Expiration")
+      "Message Expiration"
   , Option
       ['h']
       ["header"]
       (ReqArg (\s o -> o {msgheader = addheader (msgheader o) s}) "HEADER=VALUE")
-      ("Message Headers")
+      "Message Headers"
   , Option
       ['F']
       ["fnheader"]
-      (ReqArg (\s o -> o {fnheader = s:(fnheader o)}) "HEADERNAME")
-      ("Message Header for filename")
+      (ReqArg (\s o -> o {fnheader = s : (fnheader o)}) "HEADERNAME")
+      "Put filename into this header"
+  , Option
+      ['S']
+      ["suffix"]
+      (ReqArg (\s o -> o {suffix = s : (suffix o)}) "SUFFIX")
+      "Allowed file suffixes in hotfolder mode"
+  , Option
+      ['m']
+      ["magic"]
+      (NoArg (\o -> o {magic = not (magic o)}))
+      "Toggle setting content-type and content-encoding from file contents"
   ]
 
 -- | Options for the executables
@@ -315,10 +320,10 @@ addheader (Just (FieldTable oldheader)) string =
   Just $ FieldTable $ M.insert (k string) (v string) oldheader
 
 k :: String -> Text
-k s = pack $ takeWhile (/='=') s
+k s = pack $ takeWhile (/= '=') s
 
 v :: String -> FieldValue
-v s = FVString $ pack $ tail $ dropWhile (/='=') s
+v s = FVString $ pack $ tail $ dropWhile (/= '=') s
 
 -- | 'parseargs' exename argstring
 -- applies options onto argstring