{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}

import Data.Map (Map)
import qualified Data.Map as Map
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 Text.Show.Pretty (Value, PrettyVal(..), dumpStr)
import qualified Text.Show.Pretty as PShow (Value(..))

import Thermoprint.Client
import Options.Applicative

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

tprint :: TPrint -> IO ()
tprint = putStrLn . dumpStr -- *DEBUG*