module Options.Utils ( rCI , rTime , pRange , pPrinter , aDraft , pTitle , pBlock ) where import Options.Applicative import Data.Text (Text) import qualified Data.Text as T (pack) import Data.Monoid import Data.Char import Data.Maybe import Data.List import Text.Read import Data.Time import Thermoprint.Client (Range(..), PrinterId(..), DraftId(..), DraftTitle) 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 pPrinter :: Mod OptionFields PrinterId -> Parser PrinterId pPrinter mod = option (PrinterId <$> auto) $ metavar "PRINTER" <> long "printer" <> short 'p' <> mod aDraft :: Parser DraftId aDraft = argument (DraftId <$> auto) (metavar "DRAFT") pTitle :: Parser DraftTitle pTitle = option (T.pack <$> auto) $ metavar "TITLE" <> long "title" <> short 't' pBlock :: Parser Bool pBlock = switch $ long "block" <> short 'b' <> help "Do not return until job has finished printing or failed. Report errors during printing"