{-# Language TemplateHaskell, 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 ((<|>), empty, liftA2)
import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken)
import Client.Commands.Docs (integrationDocs, cmdDoc)
import Client.Commands.TabCompletion (noNetworkTab, simpleNetworkTab)
import Client.Commands.Types
import Client.State.Network (sendMsg)
import Data.Text qualified as Text
import Data.Time
import Irc.Commands (ircZnc)
import Control.Lens ((<<.~), (??), over)
import LensUtils (localTimeDay, localTimeTimeOfDay, zonedTimeLocalTime)

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

  [ NonEmpty Text
-> Args ArgsContext String -> Text -> CommandImpl String -> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"znc")
      (String -> Args ArgsContext String
forall r. String -> Args r String
remainingArg String
"arguments")
      $(integrationDocs `cmdDoc` "znc")
    (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 ArgsContext (Maybe (String, Maybe String))
-> Text
-> CommandImpl (Maybe (String, Maybe String))
-> Command
forall a.
NonEmpty Text
-> Args ArgsContext a -> Text -> CommandImpl a -> Command
Command
      (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"znc-playback")
      (Args ArgsContext (String, Maybe String)
-> Args ArgsContext (Maybe (String, Maybe String))
forall r a. Args r a -> Args r (Maybe a)
optionalArg ((String -> Maybe String -> (String, Maybe String))
-> Args ArgsContext String
-> Ap (Arg ArgsContext) (Maybe String)
-> Args ArgsContext (String, Maybe String)
forall a b c.
(a -> b -> c)
-> Ap (Arg ArgsContext) a
-> Ap (Arg ArgsContext) b
-> Ap (Arg ArgsContext) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> Args ArgsContext String
forall r. String -> Args r String
simpleToken String
"[time]") (Args ArgsContext String -> Ap (Arg ArgsContext) (Maybe String)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Args ArgsContext String
forall r. String -> Args r String
simpleToken String
"[date]"))))
      $(integrationDocs `cmdDoc` "znc-playback")
    (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
               { zonedTimeZone :: TimeZone
zonedTimeZone = TimeZone
tz
               , zonedTimeToLocalTime :: LocalTime
zonedTimeToLocalTime = 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 =
      -- asum requires base >= 4.16
      (f a -> f a -> f a) -> f a -> [f a] -> f a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty ((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