-- Copyright (c) 2006 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

{-# LANGUAGE FlexibleContexts #-}

-- | String and other utilities
module Lambdabot.Util (
        strip,
        dropFromEnd,
        splitFirstWord,
        limitStr,
        listToStr,
        showClean,
        expandTab,
        arePrefixesWithSpaceOf,
        arePrefixesOf,

        io,
        forkUnmasked,

        random,
        randomFailureMsg,
        randomSuccessMsg
    ) where

import Control.Monad.Trans
import Data.Char
import Data.List
import Data.Random
import Control.Concurrent.Lifted
import Control.Monad.Trans.Control
import Lambdabot.Config
import Lambdabot.Config.Core

------------------------------------------------------------------------

-- | Break a String into it's first word, and the rest of the string. Example:
--
-- > split_first_word "A fine day" ===> ("A", "fine day)
splitFirstWord :: String -- ^ String to be broken
                 -> (String, String)
splitFirstWord :: String -> (String, String)
splitFirstWord String
xs = (String
w, (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
xs')
  where (String
w, String
xs') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
xs

-- | Truncate a string to the specified length, putting ellipses at the
-- end if necessary.
limitStr :: Int -> String -> String
limitStr :: Int -> String -> String
limitStr Int
n String
s = let (String
b, String
t) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
s in
           if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t then String
b else Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3) String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."

-- | Form a list of terms using a single conjunction. Example:
--
-- > listToStr "and" ["a", "b", "c"] ===> "a, b and c"
listToStr :: String -> [String] -> String
listToStr :: String -> [String] -> String
listToStr String
_    []           = []
listToStr String
conj (String
item:[String]
items) =
  let listToStr' :: [String] -> String
listToStr' [] = []
      listToStr' [String
y] = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
" ", String
conj, String
" ", String
y]
      listToStr' (String
y:[String]
ys) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
", ", String
y, [String] -> String
listToStr' [String]
ys]
  in  String
item String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
listToStr' [String]
items

------------------------------------------------------------------------

-- | Pick a random element of the list.
random :: MonadIO m => [a] -> m a
random :: [a] -> m a
random = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO a -> m a) -> ([a] -> IO a) -> [a] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RVarT Identity a -> IO a
forall (d :: * -> *) (m :: * -> *) t.
(Sampleable d m t, MonadRandom m) =>
d t -> m t
sample (RVarT Identity a -> IO a)
-> ([a] -> RVarT Identity a) -> [a] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> RVarT Identity a
forall a. [a] -> RVar a
randomElement

------------------------------------------------------------------------

-- | 'strip' takes as input a predicate and a list and strips
--   elements matching the predicate from the prefix as well as
--   the suffix of the list. Example:
--
-- > strip isSpace "   abc  " ===> "abc"
strip :: (a -> Bool) -> [a] -> [a]
strip :: (a -> Bool) -> [a] -> [a]
strip a -> Bool
p = let f :: [a] -> [a]
f = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p in [a] -> [a]
f ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
f

-- | Drop elements matching a predicate from the end of a list
dropFromEnd :: (a -> Bool) -> [a] -> [a]
dropFromEnd :: (a -> Bool) -> [a] -> [a]
dropFromEnd a -> Bool
p = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

------------------------------------------------------------------------

-- | show a list without heavyweight formatting
-- NB: assumes show instance outputs a quoted 'String'.
-- under that assumption, strips the outer quotes.
showClean :: (Show a) => [a] -> String
showClean :: [a] -> String
showClean = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([String] -> String) -> ([a] -> [String]) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
forall a. [a] -> [a]
init (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
tail (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)

-- | untab an string
expandTab :: Int -> String -> String
expandTab :: Int -> String -> String
expandTab Int
w = Int -> String -> String
go Int
0
  where
    go :: Int -> String -> String
go Int
_ []         = []
    go Int
i (Char
'\t':String
xs)  = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
w) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
go Int
0 String
xs
    go Int
i (Char
x:String
xs)     = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
xs

------------------------------------------------------------------------

-- convenience:
io :: MonadIO m => IO a -> m a
io :: IO a -> m a
io = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
{-# INLINE io #-}

forkUnmasked :: MonadBaseControl IO m => m () -> m ThreadId
forkUnmasked :: m () -> m ThreadId
forkUnmasked m ()
m = ((forall a. m a -> m a) -> m ()) -> m ThreadId
forall (m :: * -> *).
MonadBaseControl IO m =>
((forall a. m a -> m a) -> m ()) -> m ThreadId
forkWithUnmask (((forall a. m a -> m a) -> m ()) -> m ThreadId)
-> ((forall a. m a -> m a) -> m ()) -> m ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask -> m () -> m ()
forall a. m a -> m a
unmask m ()
m

arePrefixesWithSpaceOf :: [String] -> String -> Bool
arePrefixesWithSpaceOf :: [String] -> String -> Bool
arePrefixesWithSpaceOf = [String] -> String -> Bool
arePrefixesOf ([String] -> String -> Bool)
-> ([String] -> [String]) -> [String] -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ")

arePrefixesOf :: [String] -> String -> Bool
arePrefixesOf :: [String] -> String -> Bool
arePrefixesOf = (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> Bool) -> [String] -> Bool)
-> (String -> String -> Bool) -> String -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> Bool) -> String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf)

--
-- Amusing insults from OpenBSD sudo
--
insult :: [String]
insult :: [String]
insult =
   [String
"Just what do you think you're doing Dave?",
    String
"It can only be attributed to human error.",
    String
"That's something I cannot allow to happen.",
    String
"My mind is going. I can feel it.",
    String
"Sorry about this, I know it's a bit silly.",
    String
"Take a stress pill and think things over.",
    String
"This mission is too important for me to allow you to jeopardize it.",
    String
"I feel much better now.",

    String
"Wrong!  You cheating scum!",
    String
"And you call yourself a Rocket Scientist!",
    String
"And you call yourself a Rocket Surgeon!",
    String
"Where did you learn to type?",
    String
"Are you on drugs?",
    String
"My pet ferret can type better than you!",
    String
"You type like i drive.",
    String
"Do you think like you type?",
    String
"Your mind just hasn't been the same since the electro-shock, has it?",
    String
"I don't think I can be your friend on Facebook anymore.",

    String
"Maybe if you used more than just two fingers...",
    String
"BOB says:  You seem to have forgotten your passwd, enter another!",
    String
"stty: unknown mode: doofus",
    String
"I can't hear you -- I'm using the scrambler.",
    String
"The more you drive -- the dumber you get.",
    String
"Listen, broccoli brains, I don't have time to listen to this trash.",
    String
"I've seen penguins that can type better than that.",
    String
"Have you considered trying to match wits with a rutabaga?",
    String
"You speak an infinite deal of nothing.",

    -- other
    String
"Are you typing with your feet?",
    String
"Abort, Retry, Panic?",

    -- More haskellish insults
    String
"You untyped fool!",
    String
"My brain just exploded"
    ]

--
-- some more friendly replies
--
apology :: [String]
apology :: [String]
apology =
   [String
"I am sorry.",String
"Sorry.",
    String
"Maybe you made a typo?",
    String
"Just try something else.",
    String
"There are some things that I just don't know.",
    String
"Whoa.",
    String
":(",String
":(",
    String
"",String
"",String
""
    ]

randomFailureMsg :: (MonadIO m, MonadConfig m) => m String
randomFailureMsg :: m String
randomFailureMsg = do
    Bool
useInsults <- Config Bool -> m Bool
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Bool
enableInsults
    [String] -> m String
forall (m :: * -> *) a. MonadIO m => [a] -> m a
random (if Bool
useInsults then [String]
insult [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
apology else [String]
apology)

--
-- Some more interesting confirmations for @remember and @where
--
confirmation :: [String]
confirmation :: [String]
confirmation =
   [String
"Done.",String
"Done.",
    String
"Okay.",
    String
"I will remember.",
    String
"Good to know.",
    String
"It is stored.",
    String
"I will never forget.",
    String
"It is forever etched in my memory.",
    String
"Nice!"
   ]

randomSuccessMsg :: MonadIO m => m String
randomSuccessMsg :: m String
randomSuccessMsg = [String] -> m String
forall (m :: * -> *) a. MonadIO m => [a] -> m a
random [String]
confirmation