{-# 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"

  [ forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"znc")
      (forall r. String -> Args r String
remainingArg String
"arguments")
      $(integrationDocs `cmdDoc` "znc")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdZnc Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"znc-playback")
      (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall r. String -> Args r String
simpleToken String
"[time]") (forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r. String -> Args r String
simpleToken String
"[date]"))))
      $(integrationDocs `cmdDoc` "znc-playback")
    forall a b. (a -> b) -> a -> b
$ 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)))
     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 <- 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) = (Lens' ZonedTime LocalTime
zonedTimeLocalTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LocalTime TimeOfDay
localTimeTimeOfDay forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ TimeOfDay
tod) ZonedTime
now
                 yesterday :: ZonedTime -> ZonedTime
yesterday = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' ZonedTime LocalTime
zonedTimeLocalTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LocalTime Day
localTimeDay) (Integer -> Day -> Day
addDays (-Integer
1))
                 fixDay :: ZonedTime -> ZonedTime
fixDay
                   | TimeOfDay
tod forall a. Ord a => a -> a -> Bool
<= TimeOfDay
nowTod = 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  <- forall {f :: * -> *} {a}.
(Alternative f, MonadFail f, ParseTime a) =>
[String] -> String -> f a
parseFormats [String]
dateFormats String
dateStr
       , Just TimeOfDay
tod  <- 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
      forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall (f :: * -> *) a. Alternative f => f a
empty (forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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])
         forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st