5 files changed, 201 insertions, 148 deletions

diff --git a/tprint/src/Instances.hs b/tprint/src/Instances.hs
new file mode 100644
index 0000000..cffb8b0
--- /dev/null
+++ b/tprint/src/Instances.hs
@@ -0,0 +1,25 @@
+module Instances where
+
+import Data.Text (Text)
+import qualified Data.Text as T (unpack)
+
+import Data.Time (UTCTime, formatTime, defaultTimeLocale)
+
+import Text.Show.Pretty (Value, PrettyVal(..), dumpStr)
+import qualified Text.Show.Pretty as PShow (Value(..))
+
+import Thermoprint.Client (Scheme(..), BaseUrl(..), PrinterId(..), JobId(..), DraftId(..), Range(..))
+
+instance PrettyVal Scheme
+instance PrettyVal BaseUrl
+instance PrettyVal PrinterId
+instance PrettyVal JobId
+instance PrettyVal DraftId
+instance PrettyVal a => PrettyVal (Range a)
+
+instance PrettyVal UTCTime where
+  prettyVal = PShow.String . formatTime defaultTimeLocale "%Z %F %X"
+
+instance PrettyVal Text where
+  prettyVal = prettyVal . T.unpack
+
diff --git a/tprint/src/Main.hs b/tprint/src/Main.hs
index e8d4670..cd6e68b 100644
--- a/tprint/src/Main.hs
+++ b/tprint/src/Main.hs
@@ -1,6 +1,4 @@
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 
 import Data.Map (Map)
 import qualified Data.Map as Map
@@ -8,157 +6,22 @@ import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Time
-       
-import Data.Foldable
-import Data.Char
-import Text.Read
-import Data.Maybe
-import Data.List
 
-import GHC.Generics (Generic)
+import Control.Monad
 
-import Text.Show.Pretty (Value, PrettyVal(..), dumpStr)
-import qualified Text.Show.Pretty as PShow (Value(..))
+import Text.Show.Pretty (dumpStr)
+
+import System.IO
 
 import Thermoprint.Client
-import Options.Applicative
+import Options
 
 import Debug.Trace
 
-instance PrettyVal Scheme
-instance PrettyVal BaseUrl
-instance PrettyVal PrinterId
-instance PrettyVal JobId
-instance PrettyVal DraftId
-instance PrettyVal a => PrettyVal (Range a)
-
-instance PrettyVal UTCTime where
-  prettyVal = PShow.String . formatTime defaultTimeLocale "%Z %F %X"
-
-instance PrettyVal Text where
-  prettyVal = prettyVal . T.unpack
-
-data TPrint = TPrint
-  { baseUrl :: BaseUrl
-  , dryRun :: Bool
-  , output :: Output
-  , operation :: Operation
-  }
-  deriving (Show, Generic, PrettyVal)
-
-data Operation
-  = Printers
-  | Jobs
-    { printer :: Maybe PrinterId
-    , jobRange :: Maybe (Range JobId)
-    , timeRange :: Maybe (Range UTCTime)
-    }
-  | JobCreate
-    { printer :: Maybe PrinterId
-    , input :: Input
-    }
-  | Job { jobId :: JobId }
-  | JobStatus { jobId :: JobId }
-  | JobDelete { jobId :: JobId }
-  | Drafts
-  | DraftCreate
-    { draftTitle :: Maybe DraftTitle
-    , input :: Input
-    }
-  | DraftReplace
-    { draftId :: DraftId
-    , draftTitle :: Maybe DraftTitle
-    , input :: Input
-    }
-  | Draft { draftId :: DraftId }
-  | DraftDelete { draftId :: DraftId }
-  | DraftPrint
-    { draftId :: DraftId
-    , printer :: Maybe PrinterId
-    }
-  deriving (Show, Generic, PrettyVal)
-
-type Input  = (Format, Source)
-type Output = (Format, Sink  )
-
-data Format = Human | BBCode | Internal | JSON
-  deriving (Enum, Bounded, Show, Read, Generic, PrettyVal)
-
-data Source = Stdin | ReadFile FilePath
-  deriving (Show, Generic, PrettyVal)
-
-data Sink = Stdout | WriteFile FilePath
-  deriving (Show, Generic, PrettyVal)
-
-cmdPrinters :: ParserInfo Operation
-cmdPrinters = info cmdPrinters' $ mconcat [ header "List all available printers"
-                                          ]
-  where cmdPrinters' = pure Printers
-
-cmdJobs :: ParserInfo Operation
-cmdJobs = info cmdJobs' $ mconcat [ header "List printjobs"
-                                  ]
-  where
-    cmdJobs' = Jobs
-      <$> optional (option (PrinterId <$> auto) $ metavar "PRINTER" <> long "printer" <> short 'p' <> help "List only jobs associated with printer #PRINTER")
-      <*> pRange (JobId <$> auto) (metavar "JOB") (long "min-job" <> short 'j' <> help "List only jobs with id greater than or equal to JOB") (long "max-job" <> short 'J' <> help "List only jobs with id less than or equal to JOB")
-      <*> pRange rTime (metavar "TIME") (long "min-time" <> short 't' <> help "List only jobs created after or at TIME") (long "max-time" <> short 'T' <> help "List only jobs created before or at TIME")
-
-pOperation :: Parser Operation
-pOperation = hsubparser $ mconcat [ command "printers" cmdPrinters
-                                  , command "jobs" cmdJobs
-                                  ]
-
-pTPrint :: Parser TPrint
-pTPrint = TPrint <$> option (eitherReader parseBaseUrl) (metavar "URL" <> long "baseurl" <> short 'u' <> help "Server to interact with" <> value (BaseUrl Http "localhost" 3000) <> showDefaultWith showBaseUrl)
-  <*> switch (long "dry-run" <> short 'n' <> help "Don't send any requests that would be expected to change the servers state" <> showDefault)
-  <*> pOutput
-  <*> pOperation
-
-pOutput :: Parser Output
-pOutput = (,) <$> pOutputFormat <*> pSink
-  where
-    pOutputFormat = option ciAuto $ metavar "FORMAT" <> long "output-format" <> short 'O' <> help ("Format to use for all output (possible values: " ++ show ([minBound..maxBound] :: [Format]) ++ ")") <> value Human <> showDefault
-    pSink = option rSink $ metavar "PATH" <> long "output" <> short 'o' <> help "Send output to PATH (`-' means stdout)" <> value Stdout <> showDefault
-    rSink = rSink' <$> str
-      where
-        rSink' "-" = Stdout
-        rSink' x   = WriteFile x
-
-ciAuto :: (Read a, Show a) => ReadM a
-ciAuto = eitherReader rRep'
-  where
-    rRep' str = case mapMaybe readMaybe $ cases str of
-      []  -> Left $ "Could not parse `" ++ str ++ "'"
-      [x] -> Right x
-      xs  -> Left $ "Ambiguous parse for `" ++ str ++ "': " ++ show xs
-    cases []     = []
-    cases (c:cs) = [(c':cs') | c' <- [toLower c, toUpper c], cs' <- cases cs]
-
-rTime :: ReadM UTCTime
-rTime = eitherReader rTime'
-  where
-    rTime' str = maybe (Left $ "Could not parse `" ++ str ++ "' as a specification of time -- try the output of `date -u +'%Y-%m-%d %H:%M:%S' \"" ++ str ++ "\"`") Right
-      . foldr (<|>) Nothing
-      $ map (flip (parseTimeM True defaultTimeLocale) str) ( "%c" : "%s" : perms' [ [time, date, timezone] | time <- ["%T", "%X", "%I:%M:%S", "%r", "%X%Q", "%I:%M:%S%Q %p"], date <- ["%x", "%F"], timezone <- ["%z", "%Z"]] )
-    perms' :: [[String]] -> [String]
-    perms' = map unwords . concatMap subsequences . concatMap permutations
-
-pRange :: ReadM a
-          -> Mod OptionFields a -- ^ Modifiers applied to both min & max
-          -> Mod OptionFields a -- ^ Modifiers for minimum
-          -> Mod OptionFields a -- ^ Modifiers for maximum
-          -> Parser (Maybe (Range a))
-pRange r both min max = toRange <$> optional (option r (both <> min)) <*> optional (option r (both <> max))
-  where
-    toRange Nothing Nothing = Nothing
-    toRange (Just min) Nothing = Just $ Min min
-    toRange Nothing (Just max) = Just $ Max max
-    toRange (Just min) (Just max) = Just $ min `Through` max
-
 main :: IO ()
-main = customExecParser (prefs $ showHelpOnError) (info pTPrint $ header "tprint - A cli interface to Thermoprint.Client") >>= tprint
+main = withArgs (tprint <=< dumpOpts)
+  where
+    dumpOpts c@(TPrint{..}) = c <$ when (dumpOptions) (hPutStrLn stderr $ dumpStr c)
 
 tprint :: TPrint -> IO ()
-tprint = putStrLn . dumpStr -- *DEBUG*
+tprint = undefined
diff --git a/tprint/src/Options.hs b/tprint/src/Options.hs
new file mode 100644
index 0000000..96bbde6
--- /dev/null
+++ b/tprint/src/Options.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
+
+module Options
+       ( TPrint(..)
+       , Operation(..)
+       , Input, Output
+       , Format(..), Source(..), Sink(..)
+       , withArgs
+       , module Options.Utils
+       ) where
+
+import Data.Time
+
+import GHC.Generics (Generic)
+
+import Text.Show.Pretty (PrettyVal)
+
+import Thermoprint.Client
+import Options.Applicative
+
+import Options.Utils
+import Instances ()
+
+data TPrint = TPrint
+  { baseUrl :: BaseUrl
+  , dryRun :: Bool
+  , output :: Output
+  , operation :: Operation
+  , dumpOptions :: Bool
+  }
+  deriving (Show, Generic, PrettyVal)
+
+data Operation
+  = Printers
+  | Jobs
+    { printer :: Maybe PrinterId
+    , jobRange :: Maybe (Range JobId)
+    , timeRange :: Maybe (Range UTCTime)
+    }
+  | JobCreate
+    { printer :: Maybe PrinterId
+    , input :: Input
+    }
+  | Job { jobId :: JobId }
+  | JobStatus { jobId :: JobId }
+  | JobDelete { jobId :: JobId }
+  | Drafts
+  | DraftCreate
+    { draftTitle :: Maybe DraftTitle
+    , input :: Input
+    }
+  | DraftReplace
+    { draftId :: DraftId
+    , draftTitle :: Maybe DraftTitle
+    , input :: Input
+    }
+  | Draft { draftId :: DraftId }
+  | DraftDelete { draftId :: DraftId }
+  | DraftPrint
+    { draftId :: DraftId
+    , printer :: Maybe PrinterId
+    }
+  deriving (Show, Generic, PrettyVal)
+
+type Input  = (Format, Source)
+type Output = (Format, Sink  )
+
+data Format = Human | BBCode | Internal | JSON
+  deriving (Enum, Bounded, Show, Read, Generic, PrettyVal)
+
+data Source = Stdin | ReadFile FilePath
+  deriving (Show, Generic, PrettyVal)
+
+data Sink = Stdout | WriteFile FilePath
+  deriving (Show, Generic, PrettyVal)
+
+cmdPrinters :: ParserInfo Operation
+cmdPrinters = info cmdPrinters' $ mconcat [ header "List all available printers"
+                                          ]
+  where cmdPrinters' = pure Printers
+
+cmdJobs :: ParserInfo Operation
+cmdJobs = info cmdJobs' $ mconcat [ header "List printjobs"
+                                  ]
+  where
+    cmdJobs' = Jobs
+      <$> optional (option (PrinterId <$> auto) $ metavar "PRINTER" <> long "printer" <> short 'p' <> help "List only jobs associated with printer #PRINTER")
+      <*> pRange (JobId <$> auto) (metavar "JOB") (long "min-job" <> short 'j' <> help "List only jobs with id greater than or equal to JOB") (long "max-job" <> short 'J' <> help "List only jobs with id less than or equal to JOB")
+      <*> pRange rTime (metavar "TIME") (long "min-time" <> short 't' <> help "List only jobs created after or at TIME") (long "max-time" <> short 'T' <> help "List only jobs created before or at TIME")
+
+pOperation :: Parser Operation
+pOperation = hsubparser $ mconcat [ command "printers" cmdPrinters
+                                  , command "jobs" cmdJobs
+                                  ]
+
+pTPrint :: Parser TPrint
+pTPrint = TPrint <$> option (eitherReader parseBaseUrl) (metavar "URL" <> long "baseurl" <> short 'u' <> help "Server to interact with" <> value (BaseUrl Http "localhost" 3000) <> showDefaultWith showBaseUrl)
+  <*> switch (long "dry-run" <> short 'n' <> help "Don't send any requests that would be expected to change the servers state" <> showDefault)
+  <*> pOutput
+  <*> pOperation
+  <*> switch (long "dump-options" <> internal)
+
+pOutput :: Parser Output
+pOutput = (,) <$> pOutputFormat <*> pSink
+  where
+    pOutputFormat = option rCI $ metavar "FORMAT" <> long "output-format" <> short 'O' <> help ("Format to use for all output (possible values: " ++ show ([minBound..maxBound] :: [Format]) ++ ")") <> value Human <> showDefault
+    pSink = option rSink $ metavar "PATH" <> long "output" <> short 'o' <> help "Send output to PATH (`-' means stdout)" <> value Stdout <> showDefault
+    rSink = rSink' <$> str
+      where
+        rSink' "-" = Stdout
+        rSink' x   = WriteFile x
+
+withArgs :: (TPrint -> IO a) -> IO a
+withArgs a = customExecParser (prefs $ showHelpOnError) (info pTPrint $ header "tprint - A cli interface to Thermoprint.Client") >>= a
diff --git a/tprint/src/Options/Utils.hs b/tprint/src/Options/Utils.hs
new file mode 100644
index 0000000..80b4a7e
--- /dev/null
+++ b/tprint/src/Options/Utils.hs
@@ -0,0 +1,48 @@
+module Options.Utils
+       ( rCI
+       , rTime
+       , pRange
+       ) where
+
+import Options.Applicative
+
+import Data.Char
+import Data.Maybe
+import Data.List
+import Text.Read
+
+import Data.Time
+
+import Thermoprint.Client (Range(..))
+
+rCI :: (Read a, Show a) => ReadM a
+rCI = eitherReader rRep'
+  where
+    rRep' str = case mapMaybe readMaybe $ cases str of
+      []  -> Left $ "Could not parse `" ++ str ++ "'"
+      [x] -> Right x
+      xs  -> Left $ "Ambiguous parse for `" ++ str ++ "': " ++ show xs
+    cases []     = []
+    cases (c:cs) = [(c':cs') | c' <- [toLower c, toUpper c], cs' <- cases cs]
+
+rTime :: ReadM UTCTime
+rTime = eitherReader rTime'
+  where
+    rTime' str = maybe (Left $ "Could not parse `" ++ str ++ "' as a specification of time -- try the output of `date -u +'%Y-%m-%d %H:%M:%S' \"" ++ str ++ "\"`") Right
+      . foldr (<|>) Nothing
+      $ map (flip (parseTimeM True defaultTimeLocale) str) ( "%c" : "%s" : perms' [ [time, date, timezone] | time <- ["%T", "%X", "%I:%M:%S", "%r", "%X%Q", "%I:%M:%S%Q %p"], date <- ["%x", "%F"], timezone <- ["%z", "%Z"]] )
+    perms' :: [[String]] -> [String]
+    perms' = map unwords . concatMap subsequences . concatMap permutations
+
+pRange :: ReadM a
+          -> Mod OptionFields a -- ^ Modifiers applied to both min & max
+          -> Mod OptionFields a -- ^ Modifiers for minimum
+          -> Mod OptionFields a -- ^ Modifiers for maximum
+          -> Parser (Maybe (Range a))
+pRange r both min max = toRange <$> optional (option r (both <> min)) <*> optional (option r (both <> max))
+  where
+    toRange Nothing Nothing = Nothing
+    toRange (Just min) Nothing = Just $ Min min
+    toRange Nothing (Just max) = Just $ Max max
+    toRange (Just min) (Just max) = Just $ min `Through` max
+
diff --git a/tprint/tprint.cabal b/tprint/tprint.cabal
index d61ea01..aeb61c9 100644
--- a/tprint/tprint.cabal
+++ b/tprint/tprint.cabal
@@ -18,7 +18,9 @@ cabal-version:       >=1.10
 
 executable tprint
   main-is:             Main.hs
-  -- other-modules:       
+  other-modules:       Options
+                     , Options.Utils
+                     , Instances
   -- other-extensions:    
   build-depends:       base >=4.8 && <4.9
                      , thermoprint-bbcode >=1.0.0 && <2
@@ -27,7 +29,7 @@ executable tprint
                      , containers >=0.5.6 && <1
                      , time >=1.5.0 && <2
                      , pretty-show >=1.6.9 && <2
-                     , text -any
+                     , text >=1.2.2 && <2
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall
\ No newline at end of file