aboutsummaryrefslogtreecommitdiff
path: root/tprint/src/Options.hs
blob: 046112f3deb2d4bf9bd0c6a79a57b6f59e708160 (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
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