Util.hs

{- This file is part of funbot.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module FunBot.Util
    ( (!?)
      --, replaceMaybe
    , passes
    , passesBy
    , getTimeStr
    , getHistoryLines
    , cmds
    , helps
    , looksLikeChan
    , notchan
    , looksLikeNick
    , notnick
    , unsnoc
    )
where

import Control.Monad (liftM)
import Control.Monad.IO.Class (liftIO)
import Data.Char
import Data.Maybe (listToMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import FunBot.Types
import Network.IRC.Fun.Bot.State (askTimeGetter, getChanInfo)
import Network.IRC.Fun.Bot.Types (ChanInfo (ciHistoryLines), CommandName (..))
import Network.IRC.Fun.Color.Style
import Network.IRC.Fun.Types.Base

import qualified Data.CaseInsensitive as CI (mk)
import qualified Data.HashMap.Lazy as M (lookup)
import qualified Data.Text as T

-- | List index operator, starting from 0. Like @!!@ but returns a 'Maybe'
-- instead of throwing an exception. On success, returns 'Just' the item. On
-- out-of-bounds index, returns 'Nothing'.
(!?) :: [a] -> Int -> Maybe a
l !? i = listToMaybe $ drop i l

-- | Replace the list item at the given position, with the given new item.
-- Return the resulting list. If the position is out of range, return
-- 'Nothing'.
--replaceMaybe :: [a] -> Int -> a -> Maybe [a]
--replaceMaybe l i y = setMaybe l i (const y)

-- | Like 'replaceMaybe', but takes a function and applies to the item.
--setMaybe :: [a] -> Int -> (a -> a) -> Maybe [a]
--setMaybe l i f =
--    case splitAt i l of
--        (_, [])   -> Nothing
--        (b, x:xs) -> Just $ b ++ f x : xs

-- | Check whether a value passes a given filter.
passes :: Eq a => a -> Filter a -> Bool
v `passes` (Accept l) = v `elem` l
v `passes` (Reject l) = v `notElem` l

-- | Like 'passes', but using a given predicate to compare items.
passesBy :: (a -> a -> Bool) -> a -> Filter a -> Bool
passesBy p v (Accept l) = any (p v) l
passesBy p v (Reject l) = all (not . p v) l

-- | Get a string specifying the current UTC time using the time getter.
getTimeStr :: BotSession Text
getTimeStr = do
    getTime <- askTimeGetter
    liftIO $ fmap snd getTime

-- | Get the number of history lines recorded in memory for a given channel. If
-- the channel doesn't have state held for it, 0 is returned.
getHistoryLines :: Channel -> BotSession Int
getHistoryLines chan = do
    cs <- getChanInfo
    return $ maybe 0 ciHistoryLines $ M.lookup chan cs

-- | Helper for specifying command names
cmds :: [Text] -> [CommandName]
cmds = map $ CommandName . CI.mk

-- | Helper for specifying command help
helps :: [(Text, Text)] -> Text
helps l = T.intercalate "\n" $ map (uncurry f) l
    where
    maxlen = maximum $ map (T.length . fst) l
    nspaces spec = maxlen - T.length spec
    spaces spec = T.replicate (nspaces spec) " "
    f spec desc = T.concat
        [ "‘"
        , encode $ Bold #> plain spec
        , "’"
        , spaces spec
        , " - "
        , desc
        ]

looksLikeChan (Channel chan) =
    case T.uncons chan of
        Nothing     -> False
        Just (c, _) -> c `elem` ("#+!&" :: String)

notchan chan = MsgContent $ unChannel chan <> " doesn’t look like a channel name."

looksLikeNick nick =
    case T.uncons nick of
        Nothing     -> False
        Just (c, r) -> first c && T.all rest r
    where
    isAsciiLetter c = isAsciiLower c || isAsciiUpper c
    isSpecial = (`elem` ("[]\\`_^{|}" :: String))
    first c = isAsciiLetter c || isSpecial c
    rest c = isAsciiLetter c || isDigit c || isSpecial c || c == '-'

notnick nick = MsgContent $ nick <> " doesn’t look like a nickname."

-- | Trivial @unsnoc@ for Text.
unsnoc :: Text -> Maybe (Text, Char)
unsnoc t =
    if T.null t
        then Nothing
        else Just (T.init t, T.last t)