@@ -50,7 +50,9 @@ import Protolude (
50
50
(<&>) ,
51
51
(||) ,
52
52
)
53
+ import Protolude qualified as P
53
54
55
+ import Control.Monad.Catch (catchAll )
54
56
import Data.Aeson as Aeson (KeyValue ((.=) ), encode , object )
55
57
import Data.FileEmbed (embedStringFile , makeRelativeToProject )
56
58
import Data.Hourglass (
@@ -66,9 +68,6 @@ import Data.Text.Lazy.Encoding qualified as TL
66
68
import Data.Time.ISO8601.Duration qualified as Iso
67
69
import Data.Version (showVersion )
68
70
import Data.Yaml (decodeFileEither , prettyPrintParseException )
69
-
70
- -- Special module provided by Cabal
71
-
72
71
import Database.SQLite.Simple (Connection (.. ))
73
72
import Database.SQLite.Simple qualified as SQLite
74
73
import GHC.IO.Encoding (setLocaleEncoding , utf8 )
@@ -154,6 +153,7 @@ import Options.Applicative (
154
153
fullDesc ,
155
154
headerDoc ,
156
155
help ,
156
+ helpHeader ,
157
157
helper ,
158
158
idm ,
159
159
info ,
@@ -169,6 +169,7 @@ import Options.Applicative (
169
169
subparser ,
170
170
switch ,
171
171
)
172
+ import Options.Applicative.Help.Chunk (Chunk (Chunk ), (<<+>>) )
172
173
import Options.Applicative.Help.Core (parserHelp )
173
174
import Paths_tasklite_core (version )
174
175
import Prettyprinter (
@@ -185,10 +186,11 @@ import Prettyprinter (
185
186
)
186
187
import Prettyprinter.Render.Terminal (
187
188
AnsiStyle ,
188
- Color (Black , Blue , Cyan , Yellow ),
189
+ Color (Black , Blue , Cyan , Red , Yellow ),
189
190
bold ,
190
191
color ,
191
192
colorDull ,
193
+ hPutDoc ,
192
194
putDoc ,
193
195
)
194
196
import System.Directory (
@@ -202,6 +204,7 @@ import System.Directory (
202
204
listDirectory ,
203
205
)
204
206
import System.FilePath ((</>) )
207
+ import System.Process (readProcess )
205
208
import Time.System (timeCurrentP )
206
209
207
210
import Config (
@@ -342,13 +345,15 @@ data Command
342
345
| Help
343
346
| PrintConfig
344
347
| UlidToUtc Text
348
+ | ExternalCommand Text (Maybe [Text ])
345
349
deriving (Show , Eq )
346
350
347
351
348
352
data CliArgs = CliArgs
349
353
{ cliCommand :: Command
350
354
, runHelpCommand :: Bool
351
355
}
356
+ deriving (Show , Eq )
352
357
353
358
354
359
nameToAliasList :: [(Text , Text )]
@@ -944,26 +949,27 @@ commandParser conf =
944
949
-- <> command "utc-quarter" -- … last day of the quarter
945
950
-- <> command "utc-year" -- … last day of the year
946
951
)
952
+
953
+ -- Catch-all parser for any external "tasklite-???" command
954
+ -- Do not show in help
955
+ <|> ExternalCommand
956
+ <$> strArgument P. mempty
957
+ <*> optional (some (strArgument P. mempty ))
947
958
)
948
959
949
960
{- FOURMOLU_ENABLE -}
950
961
951
962
952
- runHelpSwitch :: Parser Bool
953
- runHelpSwitch =
954
- switch
955
- ( long " help"
956
- <> short ' h'
957
- <> help " Display current help page"
958
- <> internal
959
- )
960
-
961
-
962
963
cliArgsParser :: Config -> Parser CliArgs
963
964
cliArgsParser conf =
964
965
CliArgs
965
966
<$> commandParser conf
966
- <*> runHelpSwitch
967
+ <*> switch
968
+ ( long " help"
969
+ <> short ' h'
970
+ <> help " Display current help page"
971
+ <> internal
972
+ )
967
973
968
974
969
975
parserInfo :: Config -> ParserInfo CliArgs
@@ -1101,7 +1107,7 @@ executeCLiCommand conf now connection = do
1101
1107
1102
1108
if runHelpCommand cliArgs
1103
1109
then pure $ extendHelp $ parserHelp defaultPrefs $ cliArgsParser conf
1104
- else case cliCommand cliArgs of
1110
+ else case cliArgs. cliCommand of
1105
1111
ListAll -> listAll conf now connection
1106
1112
ListHead -> headTasks conf now connection
1107
1113
ListNew -> newTasks conf now connection
@@ -1191,6 +1197,40 @@ executeCLiCommand conf now connection = do
1191
1197
PrintConfig -> pure $ pretty conf
1192
1198
Alias alias _ -> pure $ aliasWarning alias
1193
1199
UlidToUtc ulid -> pure $ prettyUlid ulid
1200
+ ExternalCommand cmd argsMb -> do
1201
+ let
1202
+ args =
1203
+ argsMb & P. fromMaybe []
1204
+
1205
+ runCmd = do
1206
+ output <-
1207
+ readProcess
1208
+ (" tasklite-" <> T. unpack cmd)
1209
+ (args <&> T. unpack)
1210
+ " "
1211
+ pure $ pretty output
1212
+
1213
+ handleException exception = do
1214
+ hPutDoc P. stderr $
1215
+ if not $ exception & show & T. isInfixOf " does not exist"
1216
+ then pretty (show exception :: Text )
1217
+ else do
1218
+ let
1219
+ theHelp = parserHelp defaultPrefs $ cliArgsParser conf
1220
+ newHeader =
1221
+ Chunk
1222
+ ( Just $
1223
+ annotate (color Red ) $
1224
+ " ERROR: Command \" "
1225
+ <> pretty cmd
1226
+ <> " \" does not exist"
1227
+ )
1228
+ <<+>> helpHeader theHelp
1229
+ extendHelp theHelp{helpHeader = newHeader}
1230
+
1231
+ P. exitFailure
1232
+
1233
+ catchAll runCmd handleException
1194
1234
1195
1235
1196
1236
printOutput :: [Char ] -> Config -> IO ()
0 commit comments