content: {-# Language TemplateHaskell, OverloadedStrings, BangPatterns #-}
  
  {-|
  Module      : Client.WhoReply
  Description : Parsed replies from WHO
  Copyright   : (c) TheDaemoness, 2023
  License     : ISC
  Maintainer  : emertens@gmail.com
  
  Because WHOX allows for a LOT of fiddliness regarding parameters,
  this is extracted from Client.State.Network and given its own module.
  -}
  
  module Client.WhoReply
    ( WhoReply
    , WhoReplyItem
    , newWhoReply
    , finishWhoReply
    , recordWhoReply
    , recordWhoXReply
    , mapJoinWhoFields
    , whoFilterText
    
    -- Lenses
    , whoQuery
    , whoFields
    , whoToken
    , whoDone
    , whoItems
    , whoUserInfo
    , whoIp
    , whoServer
    , whoAway
    , whoMiscFlags
    , whoHops
    , whoIdleSecs
    , whoAcct
    , whoOpLvl
    , whoRealname
    ) where
  
  import           Client.Image.Message (cleanText)
  import           Control.Lens
  import           Control.Lens.Unsound (lensProduct) -- Don't worry about it. Ctrl+F SOUNDNESS.
  import           Data.List (sort)
  import           Data.Set (Set)
  import qualified Data.Set as Set
  import           Data.Text (Text)
  import qualified Data.Text as Text
  import qualified Data.Text.Lazy as LText
  import           Irc.Identifier
  import           Irc.UserInfo
  import           Text.Read (readMaybe)
    
  data WhoReply = WhoReply
    { _whoQuery  :: !(Text, Maybe Text)
    , _whoFields :: !(Set Char)
    , _whoToken  :: !String
    , _whoDone   :: !Bool
    , _whoItems  :: ![WhoReplyItem]
    }
  
  data WhoReplyItem = WhoReplyItem
    { _whoUserInfo  :: !UserInfo
    , _whoAcct      :: !Identifier
    , _whoIp        :: !Text -- We don't have iproute; (Maybe IP) would be nice here.
    , _whoServer    :: !Identifier
    , _whoAway      :: !(Maybe Bool)
    , _whoMiscFlags :: !Text
    , _whoHops      :: !(Maybe Int)
    , _whoIdleSecs  :: !String -- This can be a Maybe Int, but prettyTime takes a String.
    , _whoOpLvl     :: !Text
    , _whoRealname  :: !Text
    } deriving (Eq, Ord)
  
  makeLenses ''WhoReply
  makeLenses ''WhoReplyItem
  
  newWhoReply :: Text -> String -> WhoReply
  newWhoReply query "" = WhoReply
    { _whoQuery = (query, Nothing)
    , _whoToken = ""
    , _whoFields = Set.empty
    , _whoDone = False
    , _whoItems = []
    }
  newWhoReply query ('%':arg) = WhoReply
    { _whoQuery = (query, Just $ Text.pack ('%':arg))
    , _whoToken = if Set.member 't' fieldSet then token' else ""
    , _whoFields = fieldSet
    , _whoDone = False
    , _whoItems = []
    }
    where
      fieldSet = Set.fromList fields
      (fields, token) = over _2 (drop 1) $ break (== ',') arg
      token' = if null token then "0" else token
  newWhoReply query arg = WhoReply
    { _whoQuery = (query, Just $ Text.pack arg)
    , _whoToken = ""
    , _whoFields = Set.empty
    , _whoDone = False
    , _whoItems = []
    }
  
  splitFlags :: String -> (Maybe Bool, Text)
  splitFlags ('G':rest) = (Just True,  Text.pack rest)
  splitFlags ('H':rest) = (Just False, Text.pack rest)
  splitFlags rest       = (Nothing,    Text.pack rest)
  
  newWhoReplyItem :: WhoReplyItem
  newWhoReplyItem = WhoReplyItem
    { _whoUserInfo  = UserInfo
      { userNick = mkId ""
      , userName = ""
      , userHost = ""
      }
    , _whoAcct      = "0"
    , _whoIp        = "255.255.255.255"
    , _whoServer    = ""
    , _whoAway      = Nothing
    , _whoMiscFlags = ""
    , _whoHops      = Nothing
    , _whoIdleSecs  = ""
    , _whoOpLvl     = "n/a"
    , _whoRealname  = ""
    }
  
  finishWhoReply :: WhoReply -> WhoReply
  finishWhoReply wr = wr { _whoDone = True, _whoItems = reverse $ sort (_whoItems wr) }
  
  recordWhoReply :: [Text] -> WhoReply -> WhoReply
  recordWhoReply [_, _, uname, host, server, nick, flags, hcrn] reply
    | _whoDone reply = reply
    | otherwise = reply { _whoItems = wri:_whoItems reply}
    where
      wri = newWhoReplyItem
        { _whoUserInfo = UserInfo { userNick = mkId nick, userName = uname, userHost = host }
        , _whoServer = mkId server
        , _whoAway = away
        , _whoMiscFlags = miscFlags
        , _whoHops = readMaybe $ Text.unpack hops
        , _whoRealname = Text.stripStart realname
        }
      (hops, realname) = Text.break (== ' ') hcrn
      (away, miscFlags) = splitFlags $ Text.unpack flags
  recordWhoReply _ reply = reply
  
  -- | Field names for WHOX replies in order, excluding 't'.
  whoXReplyFields :: [Char]
  whoXReplyFields = "cuihsnfdlaor"
  
  recordWhoXReply :: [Text] -> WhoReply -> WhoReply
  recordWhoXReply []       reply = reply
  recordWhoXReply (_:args) reply
    | _whoDone reply = reply
    | _whoToken reply == "" = withWri args
    | null args = reply
    | _whoToken reply == Text.unpack (head args) = withWri $ tail args
    | otherwise = reply
    where
      fields = filter ((flip Set.member) (_whoFields reply)) whoXReplyFields
      withWri args' = reply { _whoItems = recordWhoXReply' (zip args' fields) newWhoReplyItem:_whoItems reply}
  
  recordWhoXReply' :: [(Text, Char)] -> WhoReplyItem -> WhoReplyItem
  recordWhoXReply' [] = id
  recordWhoXReply' ((arg, kind):rest) = recordWhoXReply' rest . updateFn
    where
      updateFn = case kind of
        'a' -> set whoAcct (mkId arg)
        -- Skip c
        'd' -> set whoHops (readMaybe $ Text.unpack arg)
        -- SOUNDNESS: whoAway and whoMiscFlags project disjoint parts of WhoReplyItem
        'f' -> set (lensProduct whoAway whoMiscFlags) flagsSplit
        'h' -> set (whoUserInfo . uiHost) arg
        'i' -> set whoIp arg
        'l' -> set whoIdleSecs (Text.unpack arg)
        'n' -> set (whoUserInfo . uiNick) (mkId arg)
        'o' -> set whoOpLvl arg
        'r' -> set whoRealname arg
        's' -> set whoServer (mkId arg)
        'u' -> set (whoUserInfo . uiName) arg
        _   -> id
      flagsSplit = splitFlags $ Text.unpack arg
  
  -- Map non-default field values and join them into a list.
  mapJoinWhoFields :: WhoReplyItem ->
    (UserInfo -> a) ->
    (Identifier -> a) ->
    (Text -> a) ->
    (Identifier -> a) ->
    a ->
    (Text -> a) ->
    (Int -> a) ->
    (String -> a) ->
    (Text -> a) ->
    (Text -> a) ->
    [a]
  mapJoinWhoFields wri userinfo acct ip server away flags hops idle oplvl gecos = reverse $
    addFieldIf (require notNull . view whoRealname) gecos $
    addFieldIf (require (/= "n/a") . view whoOpLvl) oplvl $
    addFieldIf (require notNullOrZero . view whoIdleSecs) idle $
    addFieldIf (\n -> view whoHops n >>= require (> 0)) hops $
    addFieldIf (require notNull . view whoMiscFlags) flags $
    addFieldIf (\n -> view whoAway n >>= require id) (const away) $
    addFieldIf (require (notNull . idText) . view whoServer) server $
    addFieldIf (require (/= "255.255.255.255") . view whoIp) ip $
    addFieldIf (require (/= "0") . view whoAcct) acct
    [userinfo $ view whoUserInfo wri]
    where
      addFieldIf :: (WhoReplyItem -> Maybe a) -> (a -> b) -> [b] -> [b]
      addFieldIf getF mapF list = case getF wri of
        Just v -> mapF v:list
        Nothing -> list
      notNull = not . Text.null
      notNullOrZero ""  = False
      notNullOrZero "0" = False
      notNullOrZero _   = True
      require f v
        | f v = Just v
        | otherwise = Nothing
  
  whoFilterText :: WhoReplyItem -> LText.Text
  whoFilterText entry = LText.fromChunks $ concat $ mapJoinWhoFields entry
    (\x -> [renderUserInfo x])
    (\x -> [" $a:", idText x])
    (\x -> [" ip: ", x])
    (\x -> [" server: ", idText x])
    [" away"]
    (\x -> [" flags: ", x])
    (\x -> [" hops: ", Text.pack $ show x])
    (\x -> [" idle: ", Text.pack x])
    (\x -> [" oplvl: ", x])
    (\x -> [" gecos: ", cleanText x])
  