-- |
-- Module      : Network.IRC.Client.Lens
-- Copyright   : (c) 2017 Michael Walker
-- License     : MIT
-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>
-- Stability   : experimental
-- Portability : CPP
--
-- 'Lens'es and 'Prism's.
module Network.IRC.Client.Lens where

import           Control.Concurrent.STM            (TVar)
import           Control.Monad.Catch               (SomeException)
import           Data.ByteString                   (ByteString)
import           Data.Profunctor                   (Choice(right'),
                                                    Profunctor(dimap))
import           Data.Text                         (Text)
import           Data.Time                         (NominalDiffTime)

import           Network.IRC.Client.Internal.Lens
import           Network.IRC.Client.Internal.Types

{-# ANN module ("HLint: ignore Redundant lambda") #-}

-- CPP seem to dislike the first ' on the RHS…
-- This style of CPP usage doesn't work with clang, which means won't work on Mac.
{-
#define PRIME() '

#define LENS(S,F,A) \
    {-# INLINE F #-}; \
    {-| PRIME()Lens' for '_/**/F'. -}; \
    F :: Lens' S A; \
    F = \ afb s -> (\ b -> s {_/**/F = b}) <$> afb (_/**/F s)

#define GETTER(S,F,A) \
    {-# INLINE F #-}; \
    {-| PRIME()Getter' for '_/**/F'. -}; \
    F :: Getter S A; \
    F = \ afb s -> (\ b -> s {_/**/F = b}) <$> afb (_/**/F s)

#define PRISM(S,C,ARG,TUP,A) \
    {-| PRIME()Prism' for 'C'. -}; \
    {-# INLINE _/**/C #-}; \
    _/**/C :: Prism' S A; \
    _/**/C = dimap (\ s -> case s of C ARG -> Right TUP; _ -> Left s) \
        (either pure $ fmap (\ TUP -> C ARG)) . right'

-}

-------------------------------------------------------------------------------
-- * Lenses for 'IRCState'

{-# INLINE connectionConfig #-}
{-| 'Getter' for '_connectionConfig'. -}
connectionConfig :: Getter (IRCState s) (ConnectionConfig s)
connectionConfig :: forall s. Getter (IRCState s) (ConnectionConfig s)
connectionConfig = \ ConnectionConfig s -> f (ConnectionConfig s)
afb IRCState s
s -> (\ ConnectionConfig s
b -> IRCState s
s {_connectionConfig :: ConnectionConfig s
_connectionConfig = ConnectionConfig s
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionConfig s -> f (ConnectionConfig s)
afb (forall s. IRCState s -> ConnectionConfig s
_connectionConfig IRCState s
s)

{-# INLINE userState #-}
{-| 'Lens' for '_userState'. -}
userState :: Lens' (IRCState s) (TVar s)
userState :: forall s. Lens' (IRCState s) (TVar s)
userState = \ TVar s -> f (TVar s)
afb IRCState s
s -> (\ TVar s
b -> IRCState s
s {_userState :: TVar s
_userState = TVar s
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar s -> f (TVar s)
afb (forall s. IRCState s -> TVar s
_userState IRCState s
s)

{-# INLINE instanceConfig #-}
{-| 'Lens' for '_instanceConfig'. -}
instanceConfig :: Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig :: forall s. Lens' (IRCState s) (TVar (InstanceConfig s))
instanceConfig = \ TVar (InstanceConfig s) -> f (TVar (InstanceConfig s))
afb IRCState s
s -> (\ TVar (InstanceConfig s)
b -> IRCState s
s {_instanceConfig :: TVar (InstanceConfig s)
_instanceConfig = TVar (InstanceConfig s)
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (InstanceConfig s) -> f (TVar (InstanceConfig s))
afb (forall s. IRCState s -> TVar (InstanceConfig s)
_instanceConfig IRCState s
s)

{-# INLINE connectionState #-}
{-| 'Lens' for '_connectionState'. -}
connectionState :: Lens' (IRCState s) (TVar ConnectionState)
connectionState :: forall s. Lens' (IRCState s) (TVar ConnectionState)
connectionState = \ TVar ConnectionState -> f (TVar ConnectionState)
afb IRCState s
s -> (\ TVar ConnectionState
b -> IRCState s
s {_connectionState :: TVar ConnectionState
_connectionState = TVar ConnectionState
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ConnectionState -> f (TVar ConnectionState)
afb (forall s. IRCState s -> TVar ConnectionState
_connectionState IRCState s
s)

-------------------------------------------------------------------------------
-- * Lenses for 'ConnectionConfig'

{-# INLINE server #-}
{-| 'Getter' for '_server'. -}
server :: Getter (ConnectionConfig s) ByteString
server :: forall s. Getter (ConnectionConfig s) ByteString
server = \ ByteString -> f ByteString
afb ConnectionConfig s
s -> (\ ByteString
b -> ConnectionConfig s
s {_server :: ByteString
_server = ByteString
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f ByteString
afb (forall s. ConnectionConfig s -> ByteString
_server ConnectionConfig s
s)

{-# INLINE port #-}
{-| 'Getter' for '_port'. -}
port :: Getter (ConnectionConfig s) Int
port :: forall s. Getter (ConnectionConfig s) Int
port = \ Int -> f Int
afb ConnectionConfig s
s -> (\ Int
b -> ConnectionConfig s
s {_port :: Int
_port = Int
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
afb (forall s. ConnectionConfig s -> Int
_port ConnectionConfig s
s)

{-# INLINE username #-}
{-| 'Lens' for '_username'. -}
username :: Lens' (ConnectionConfig s) Text
username :: forall s. Lens' (ConnectionConfig s) Text
username = \ Text -> f Text
afb ConnectionConfig s
s -> (\ Text
b -> ConnectionConfig s
s {_username :: Text
_username = Text
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
afb (forall s. ConnectionConfig s -> Text
_username ConnectionConfig s
s)

{-# INLINE realname #-}
{-| 'Lens' for '_realname'. -}
realname :: Lens' (ConnectionConfig s) Text
realname :: forall s. Lens' (ConnectionConfig s) Text
realname = \ Text -> f Text
afb ConnectionConfig s
s -> (\ Text
b -> ConnectionConfig s
s {_realname :: Text
_realname = Text
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
afb (forall s. ConnectionConfig s -> Text
_realname ConnectionConfig s
s)

{-# INLINE password #-}
{-| 'Lens' for '_password'. -}
password :: Lens' (ConnectionConfig s) (Maybe Text)
password :: forall s. Lens' (ConnectionConfig s) (Maybe Text)
password = \ Maybe Text -> f (Maybe Text)
afb ConnectionConfig s
s -> (\ Maybe Text
b -> ConnectionConfig s
s {_password :: Maybe Text
_password = Maybe Text
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> f (Maybe Text)
afb (forall s. ConnectionConfig s -> Maybe Text
_password ConnectionConfig s
s)

{-# INLINE flood #-}
{-| 'Lens' for '_flood'. -}
flood :: Lens' (ConnectionConfig s) NominalDiffTime
flood :: forall s. Lens' (ConnectionConfig s) NominalDiffTime
flood = \ NominalDiffTime -> f NominalDiffTime
afb ConnectionConfig s
s -> (\ NominalDiffTime
b -> ConnectionConfig s
s {_flood :: NominalDiffTime
_flood = NominalDiffTime
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NominalDiffTime -> f NominalDiffTime
afb (forall s. ConnectionConfig s -> NominalDiffTime
_flood ConnectionConfig s
s)

{-# INLINE timeout #-}
{-| 'Lens' for '_timeout'. -}
timeout :: Lens' (ConnectionConfig s) NominalDiffTime
timeout :: forall s. Lens' (ConnectionConfig s) NominalDiffTime
timeout = \ NominalDiffTime -> f NominalDiffTime
afb ConnectionConfig s
s -> (\ NominalDiffTime
b -> ConnectionConfig s
s {_timeout :: NominalDiffTime
_timeout = NominalDiffTime
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NominalDiffTime -> f NominalDiffTime
afb (forall s. ConnectionConfig s -> NominalDiffTime
_timeout ConnectionConfig s
s)

{-# INLINE onconnect #-}
{-| 'Lens' for '_onconnect'. -}
onconnect :: Lens' (ConnectionConfig s) (IRC s ())
onconnect :: forall s. Lens' (ConnectionConfig s) (IRC s ())
onconnect = \ IRC s () -> f (IRC s ())
afb ConnectionConfig s
s -> (\ IRC s ()
b -> ConnectionConfig s
s {_onconnect :: IRC s ()
_onconnect = IRC s ()
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IRC s () -> f (IRC s ())
afb (forall s. ConnectionConfig s -> IRC s ()
_onconnect ConnectionConfig s
s)

{-# INLINE ondisconnect #-}
{-| 'Lens' for '_ondisconnect'. -}
ondisconnect :: Lens' (ConnectionConfig s) (Maybe SomeException -> IRC s ())
ondisconnect :: forall s.
Lens' (ConnectionConfig s) (Maybe SomeException -> IRC s ())
ondisconnect = \ (Maybe SomeException -> IRC s ())
-> f (Maybe SomeException -> IRC s ())
afb ConnectionConfig s
s -> (\ Maybe SomeException -> IRC s ()
b -> ConnectionConfig s
s {_ondisconnect :: Maybe SomeException -> IRC s ()
_ondisconnect = Maybe SomeException -> IRC s ()
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe SomeException -> IRC s ())
-> f (Maybe SomeException -> IRC s ())
afb (forall s. ConnectionConfig s -> Maybe SomeException -> IRC s ()
_ondisconnect ConnectionConfig s
s)

{-# INLINE logfunc #-}
{-| 'Lens' for '_logfunc'. -}
logfunc :: Lens' (ConnectionConfig s) (Origin -> ByteString -> IO ())
logfunc :: forall s.
Lens' (ConnectionConfig s) (Origin -> ByteString -> IO ())
logfunc = \ (Origin -> ByteString -> IO ())
-> f (Origin -> ByteString -> IO ())
afb ConnectionConfig s
s -> (\ Origin -> ByteString -> IO ()
b -> ConnectionConfig s
s {_logfunc :: Origin -> ByteString -> IO ()
_logfunc = Origin -> ByteString -> IO ()
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Origin -> ByteString -> IO ())
-> f (Origin -> ByteString -> IO ())
afb (forall s. ConnectionConfig s -> Origin -> ByteString -> IO ()
_logfunc ConnectionConfig s
s)

-------------------------------------------------------------------------------
-- * Lenses for 'InstanceConfig'

{-# INLINE nick #-}
{-| 'Lens' for '_nick'. -}
nick :: Lens' (InstanceConfig s) Text
nick :: forall s. Lens' (InstanceConfig s) Text
nick = \ Text -> f Text
afb InstanceConfig s
s -> (\ Text
b -> InstanceConfig s
s {_nick :: Text
_nick = Text
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
afb (forall s. InstanceConfig s -> Text
_nick InstanceConfig s
s)

{-# INLINE channels #-}
{-| 'Lens' for '_channels'. -}
channels :: Lens' (InstanceConfig s) [Text]
channels :: forall s. Lens' (InstanceConfig s) [Text]
channels = \ [Text] -> f [Text]
afb InstanceConfig s
s -> (\ [Text]
b -> InstanceConfig s
s {_channels :: [Text]
_channels = [Text]
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> f [Text]
afb (forall s. InstanceConfig s -> [Text]
_channels InstanceConfig s
s)

{-# INLINE version #-}
{-| 'Lens' for '_version'. -}
version :: Lens' (InstanceConfig s) Text
version :: forall s. Lens' (InstanceConfig s) Text
version = \ Text -> f Text
afb InstanceConfig s
s -> (\ Text
b -> InstanceConfig s
s {_version :: Text
_version = Text
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
afb (forall s. InstanceConfig s -> Text
_version InstanceConfig s
s)

{-# INLINE handlers #-}
{-| 'Lens' for '_version'. -}
handlers :: Lens' (InstanceConfig s) [EventHandler s]
handlers :: forall s. Lens' (InstanceConfig s) [EventHandler s]
handlers = \ [EventHandler s] -> f [EventHandler s]
afb InstanceConfig s
s -> (\ [EventHandler s]
b -> InstanceConfig s
s {_handlers :: [EventHandler s]
_handlers = [EventHandler s]
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EventHandler s] -> f [EventHandler s]
afb (forall s. InstanceConfig s -> [EventHandler s]
_handlers InstanceConfig s
s)

{-# INLINE ignore #-}
{-| 'Lens' for '_ignore'. -}
ignore :: Lens' (InstanceConfig s) [(Text, Maybe Text)]
ignore :: forall s. Lens' (InstanceConfig s) [(Text, Maybe Text)]
ignore = \ [(Text, Maybe Text)] -> f [(Text, Maybe Text)]
afb InstanceConfig s
s -> (\ [(Text, Maybe Text)]
b -> InstanceConfig s
s {_ignore :: [(Text, Maybe Text)]
_ignore = [(Text, Maybe Text)]
b}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe Text)] -> f [(Text, Maybe Text)]
afb (forall s. InstanceConfig s -> [(Text, Maybe Text)]
_ignore InstanceConfig s
s)

-------------------------------------------------------------------------------
-- * Prisms for 'ConnectionState'

{-| 'Prism' for 'Connected'. -}
{-# INLINE _Connected #-}
_Connected :: Prism' ConnectionState ()
_Connected :: Prism' ConnectionState ()
_Connected = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\ ConnectionState
s -> case ConnectionState
s of ConnectionState
Connected -> forall a b. b -> Either a b
Right (); ConnectionState
_ -> forall a b. a -> Either a b
Left ConnectionState
s)
    (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ () -> ConnectionState
Connected)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

{-| 'Prism' for 'Disconnecting'. -}
{-# INLINE _Disconnecting #-}
_Disconnecting :: Prism' ConnectionState ()
_Disconnecting :: Prism' ConnectionState ()
_Disconnecting = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\ ConnectionState
s -> case ConnectionState
s of ConnectionState
Disconnecting -> forall a b. b -> Either a b
Right (); ConnectionState
_ -> forall a b. a -> Either a b
Left ConnectionState
s)
    (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ () -> ConnectionState
Disconnecting)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

{-| 'Prism' for 'Disconnected'. -}
{-# INLINE _Disconnected #-}
_Disconnected :: Prism' ConnectionState ()
_Disconnected :: Prism' ConnectionState ()
_Disconnected = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\ ConnectionState
s -> case ConnectionState
s of ConnectionState
Disconnected -> forall a b. b -> Either a b
Right (); ConnectionState
_ -> forall a b. a -> Either a b
Left ConnectionState
s)
    (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ () -> ConnectionState
Disconnected)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

-------------------------------------------------------------------------------
-- * Prisms for 'Origin'

{-| 'Prism' for 'FromServer'. -}
{-# INLINE _FromServer #-}
_FromServer :: Prism' Origin ()
_FromServer :: Prism' Origin ()
_FromServer = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\ Origin
s -> case Origin
s of Origin
FromServer -> forall a b. b -> Either a b
Right (); Origin
_ -> forall a b. a -> Either a b
Left Origin
s)
    (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ () -> Origin
FromServer)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

{-| 'Prism' for 'FromClient'. -}
{-# INLINE _FromClient #-}
_FromClient :: Prism' Origin ()
_FromClient :: Prism' Origin ()
_FromClient = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\ Origin
s -> case Origin
s of Origin
FromClient -> forall a b. b -> Either a b
Right (); Origin
_ -> forall a b. a -> Either a b
Left Origin
s)
    (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ () -> Origin
FromClient)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'