{-# Language OverloadedStrings #-}
{-|
Module      : Client.Commands.ZNC
Description : ZNC command implementations
Copyright   : (c) Eric Mertens, 2016-2020
License     : ISC
Maintainer  : emertens@gmail.com
-}

module Client.Commands.ZNC (zncCommands) where

import           Control.Applicative
import           Client.Commands.Arguments.Spec
import           Client.Commands.TabCompletion
import           Client.Commands.Types
import           Client.State.Network (sendMsg)
import           Data.Foldable (asum)
import qualified Data.Text as Text
import           Data.Time
import           Irc.Commands
import           Control.Lens
import           LensUtils (localTimeDay, localTimeTimeOfDay, zonedTimeLocalTime)

zncCommands :: CommandSection
zncCommands :: CommandSection
zncCommands = Text -> [Command] -> CommandSection
CommandSection Text
"ZNC Support"

  [ NonEmpty Text
-> Args ClientState String -> Text -> CommandImpl String -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"znc")
      (String -> Args ClientState String
forall r. String -> Args r String
remainingArg String
"arguments")
      Text
"Send command directly to ZNC.\n\
      \\n\
      \The advantage of this over /msg is that responses are not broadcast to call clients.\n"
    (CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand String
-> (Bool -> NetworkCommand String) -> CommandImpl String
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdZnc Bool -> NetworkCommand String
simpleNetworkTab

  , NonEmpty Text
-> Args ClientState (Maybe (String, Maybe String))
-> Text
-> CommandImpl (Maybe (String, Maybe String))
-> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"znc-playback")
      (Args ClientState (String, Maybe String)
-> Args ClientState (Maybe (String, Maybe String))
forall r a. Args r a -> Args r (Maybe a)
optionalArg ((String -> Maybe String -> (String, Maybe String))
-> Args ClientState String
-> Ap (Arg ClientState) (Maybe String)
-> Args ClientState (String, Maybe String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Args ClientState String
forall r. String -> Args r String
simpleToken String
"[time]") (Args ClientState String -> Ap (Arg ClientState) (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Args ClientState String
forall r. String -> Args r String
simpleToken String
"[date]"))))
      Text
"Request playback from the ZNC 'playback' module.\n\
      \\n\
      \\^Btime\^B determines the time to playback since.\n\
      \\^Bdate\^B determines the date to playback since.\n\
      \\n\
      \When both \^Btime\^B and \^Bdate\^B are omitted, all playback is requested.\n\
      \When both \^Bdate\^B is omitted it is defaulted the most recent date in the past that makes sense.\n\
      \\n\
      \Time format: HOURS:MINUTES (example: 7:00)\n\
      \Date format: YEAR-MONTH-DAY (example: 2016-06-16)\n\
      \\n\
      \Note that the playback module is not installed in ZNC by default!\n"
    (CommandImpl (Maybe (String, Maybe String)) -> Command)
-> CommandImpl (Maybe (String, Maybe String)) -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand (Maybe (String, Maybe String))
-> (Bool -> NetworkCommand String)
-> CommandImpl (Maybe (String, Maybe String))
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand (Maybe (String, Maybe String))
cmdZncPlayback Bool -> NetworkCommand String
noNetworkTab

  ]

cmdZnc :: NetworkCommand String
cmdZnc :: NetworkCommand String
cmdZnc NetworkState
cs ClientState
st String
rest =
  do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircZnc (Text -> [Text]
Text.words (String -> Text
Text.pack String
rest)))
     ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st

cmdZncPlayback :: NetworkCommand (Maybe (String, Maybe String))
cmdZncPlayback :: NetworkCommand (Maybe (String, Maybe String))
cmdZncPlayback NetworkState
cs ClientState
st Maybe (String, Maybe String)
args =
  case Maybe (String, Maybe String)
args of

    -- request everything
    Maybe (String, Maybe String)
Nothing -> String -> IO CommandResult
success String
"0"

    -- current date explicit time
    Just (String
timeStr, Maybe String
Nothing)
       | Just TimeOfDay
tod <- [String] -> String -> Maybe TimeOfDay
forall (f :: * -> *) a.
(Alternative f, MonadFail f, ParseTime a) =>
[String] -> String -> f a
parseFormats [String]
timeFormats String
timeStr ->
          do ZonedTime
now <- IO ZonedTime
getZonedTime
             let (TimeOfDay
nowTod,ZonedTime
t) = ((LocalTime -> (TimeOfDay, LocalTime))
-> ZonedTime -> (TimeOfDay, ZonedTime)
Lens' ZonedTime LocalTime
zonedTimeLocalTime ((LocalTime -> (TimeOfDay, LocalTime))
 -> ZonedTime -> (TimeOfDay, ZonedTime))
-> ((TimeOfDay -> (TimeOfDay, TimeOfDay))
    -> LocalTime -> (TimeOfDay, LocalTime))
-> (TimeOfDay -> (TimeOfDay, TimeOfDay))
-> ZonedTime
-> (TimeOfDay, ZonedTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeOfDay -> (TimeOfDay, TimeOfDay))
-> LocalTime -> (TimeOfDay, LocalTime)
Lens' LocalTime TimeOfDay
localTimeTimeOfDay ((TimeOfDay -> (TimeOfDay, TimeOfDay))
 -> ZonedTime -> (TimeOfDay, ZonedTime))
-> TimeOfDay -> ZonedTime -> (TimeOfDay, ZonedTime)
forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ TimeOfDay
tod) ZonedTime
now
                 yesterday :: ZonedTime -> ZonedTime
yesterday = ASetter ZonedTime ZonedTime Day Day
-> (Day -> Day) -> ZonedTime -> ZonedTime
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((LocalTime -> Identity LocalTime)
-> ZonedTime -> Identity ZonedTime
Lens' ZonedTime LocalTime
zonedTimeLocalTime ((LocalTime -> Identity LocalTime)
 -> ZonedTime -> Identity ZonedTime)
-> ((Day -> Identity Day) -> LocalTime -> Identity LocalTime)
-> ASetter ZonedTime ZonedTime Day Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day -> Identity Day) -> LocalTime -> Identity LocalTime
Lens' LocalTime Day
localTimeDay) (Integer -> Day -> Day
addDays (-Integer
1))
                 fixDay :: ZonedTime -> ZonedTime
fixDay
                   | TimeOfDay
tod TimeOfDay -> TimeOfDay -> Bool
forall a. Ord a => a -> a -> Bool
<= TimeOfDay
nowTod = ZonedTime -> ZonedTime
forall a. a -> a
id
                   | Bool
otherwise     = ZonedTime -> ZonedTime
yesterday
             ZonedTime -> IO CommandResult
successZoned (ZonedTime -> ZonedTime
fixDay ZonedTime
t)

    -- explicit date and time
    Just (String
timeStr, Just String
dateStr)
       | Just Day
day  <- [String] -> String -> Maybe Day
forall (f :: * -> *) a.
(Alternative f, MonadFail f, ParseTime a) =>
[String] -> String -> f a
parseFormats [String]
dateFormats String
dateStr
       , Just TimeOfDay
tod  <- [String] -> String -> Maybe TimeOfDay
forall (f :: * -> *) a.
(Alternative f, MonadFail f, ParseTime a) =>
[String] -> String -> f a
parseFormats [String]
timeFormats String
timeStr ->
          do TimeZone
tz <- IO TimeZone
getCurrentTimeZone
             ZonedTime -> IO CommandResult
successZoned ZonedTime :: LocalTime -> TimeZone -> ZonedTime
ZonedTime
               { zonedTimeZone :: TimeZone
zonedTimeZone = TimeZone
tz
               , zonedTimeToLocalTime :: LocalTime
zonedTimeToLocalTime = LocalTime :: Day -> TimeOfDay -> LocalTime
LocalTime
                   { localTimeOfDay :: TimeOfDay
localTimeOfDay = TimeOfDay
tod
                   , localDay :: Day
localDay       = Day
day } }

    Maybe (String, Maybe String)
_ -> Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"unable to parse date/time arguments" ClientState
st

  where
    -- %k doesn't require a leading 0 for times before 10AM
    timeFormats :: [String]
timeFormats = [String
"%k:%M:%S",String
"%k:%M"]
    dateFormats :: [String]
dateFormats = [String
"%F"]
    parseFormats :: [String] -> String -> f a
parseFormats [String]
formats String
str =
      [f a] -> f a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((String -> f a) -> [String] -> [f a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TimeLocale -> String -> String -> f a
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale (String -> String -> f a) -> String -> String -> f a
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? String
str) [String]
formats)

    successZoned :: ZonedTime -> IO CommandResult
successZoned = String -> IO CommandResult
success (String -> IO CommandResult)
-> (ZonedTime -> String) -> ZonedTime -> IO CommandResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%s"

    success :: String -> IO CommandResult
success String
start =
      do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircZnc [Text
"*playback", Text
"play", Text
"*", String -> Text
Text.pack String
start])
         ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st