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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module Options
( TPrint(..)
, Operation(..)
, Input, Output
, Format(..), Source(..), Sink(..)
, supportedInputs, supportedOutputs
, 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 ()
import Paths_tprint (version)
import Data.Version (showVersion)
import Data.Maybe
import Data.Monoid
import Data.Bifunctor (Bifunctor(..))
import System.Environment (lookupEnv)
data TPrint = TPrint
{ baseUrl :: BaseUrl
, dryRun :: Bool
, output :: Output
, operation :: Operation
, dumpOptions :: Bool
}
deriving (Show, Generic, PrettyVal)
data Interactive = Interactive
deriving (Show, Generic, PrettyVal)
data Operation
= Printers
| Jobs
{ printer :: Maybe PrinterId
, jobRange :: Maybe (Range JobId)
, timeRange :: Maybe (Range UTCTime)
}
| JobCreate
{ printer :: Maybe PrinterId
, block :: Bool
, 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
}
| DraftEdit { mDraftId :: Maybe DraftId }
| Draft { draftId :: DraftId }
| DraftDelete { draftId :: DraftId }
| DraftPrint
{ draftId :: DraftId
, block :: Bool
, 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)
supportedInputs, supportedOutputs :: [Format]
supportedInputs = [BBCode, JSON]
supportedOutputs = [Human, BBCode, Internal, JSON]
cmdPrinters, cmdJobs, cmdJobCreate, cmdJob, cmdJobStatus, cmdJobDelete, cmdDrafts, cmdDraftCreate, cmdDraftReplace, cmdDraftEdit, cmdDraft, cmdDraftDelete, cmdDraftPrint :: ParserInfo Operation
cmdPrinters = info cmdPrinters' $ progDesc "List all available printers"
where cmdPrinters' = pure Printers
cmdJobs = info cmdJobs' $ progDesc "List printjobs"
where cmdJobs' = Jobs
<$> optional (pPrinter $ 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")
cmdJobCreate = info cmdJobCreate' $ progDesc "Queue a new job"
where cmdJobCreate' = JobCreate
<$> optional (pPrinter $ help "Direct for the job to printed on #PRINTER specifically")
<*> pBlock
<*> pInput
cmdJob = info cmdJob' $ progDesc "Retrieve a jobs contents"
where cmdJob' = Job <$> argument (JobId <$> auto) (metavar "JOB")
cmdJobStatus = info cmdJobStatus' $ progDesc "Find a jobs current status"
where cmdJobStatus' = JobStatus <$> argument (JobId <$> auto) (metavar "JOB")
cmdJobDelete = info cmdJobDelete' $ progDesc "Prevent a job from being printed"
where cmdJobDelete' = JobDelete <$> argument (JobId <$> auto) (metavar "JOB")
cmdDrafts = info cmdDrafts' $ progDesc "List drafts"
where cmdDrafts' = pure Drafts
cmdDraftCreate = info cmdDraftCreate' $ progDesc "Create a new draft"
where cmdDraftCreate' = DraftCreate <$> optional pTitle <*> pInput
cmdDraftReplace = info cmdDraftReplace' $ progDesc "Update the contents and title of a draft"
where cmdDraftReplace' = DraftReplace <$> aDraft <*> optional pTitle <*> pInput
cmdDraftEdit = info cmdDraftEdit' $ progDesc "Edit or create a draft"
where cmdDraftEdit' = DraftEdit <$> optional aDraft
cmdDraft = info cmdDraft' $ progDesc "Retrieve a drafts contents"
where cmdDraft' = Draft <$> aDraft
cmdDraftDelete = info cmdDraftDelete' $ progDesc "Delete a draft"
where cmdDraftDelete' = DraftDelete <$> aDraft
cmdDraftPrint = info cmdDraftPrint' $ progDesc "Queue a copy of a drafts contents to be printed"
where cmdDraftPrint' = DraftPrint <$> aDraft <*> pBlock <*> optional (pPrinter $ help "Direct for the drafts contents to be printed on #PRINTER specifically")
pOperation :: Parser Operation
pOperation = hsubparser $ mconcat [ command "printers" cmdPrinters
, command "jobs" cmdJobs
, command "drafts" cmdDrafts
, command "job" $ info ( hsubparser $ mconcat [ command "create" cmdJobCreate
, command "content" cmdJob
, command "status" cmdJobStatus
, command "abort" cmdJobDelete
]
) (progDesc "Interact with jobs")
, command "draft" $ info ( hsubparser $ mconcat [ command "create" cmdDraftCreate
, command "replace" cmdDraftReplace
, command "interact" cmdDraftEdit
, command "content" cmdDraft
, command "delete" cmdDraftDelete
, command "print" cmdDraftPrint
]
) (progDesc "Interact with drafts")
]
pTPrint :: IO (Parser TPrint)
pTPrint = do
baseUrl <- parseBaseUrl =<< (fromMaybe "http://localhost:3000/" <$> lookupEnv "TPRINT_BASEURL")
return $
TPrint <$> option (eitherReader $ first show . parseBaseUrl) (metavar "URL" <> long "baseurl" <> short 'u' <> help "Server to interact with; also read from TPRINT_BASEURL when set" <> value baseUrl <> showDefaultWith showBaseUrl)
<*> switch (long "dry-run" <> short 'n' <> help "Don't send any requests that would be expected to change the servers state")
<*> 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 supportedOutputs ++ ")\nNo guarantees are made whether a format works for any given subcommand, unsupported formats are silently replaced with variations on the theme of `Human'") <> value (head supportedOutputs) <> 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
pInput :: Parser Input
pInput = (,) <$> pInputFormat <*> pSource
where
pInputFormat = option rCI $ metavar "FORMAT" <> long "input-format" <> short 'f' <> help ("Format to parse as input (possible values: " ++ show supportedInputs ++ ")") <> value (head supportedInputs) <> showDefault
pSource = argument rSource $ metavar "PATH" <> help "Read input from PATH (`-' means stdout)" <> value Stdin <> showDefault
rSource = rSource' <$> str
where
rSource' "-" = Stdin
rSource' x = ReadFile x
withArgs :: (TPrint -> IO a) -> IO a
withArgs a = do
pTPrint' <- pTPrint
customExecParser (prefs $ showHelpOnError) (info pTPrint' $ header ("tprint " ++ showVersion version) <> progDesc "A cli for Thermoprint.Client") >>= a
|
