{-# LANGUAGE TypeFamilies #-}

module Lambdabot.Plugin.Novelty.Numberwang (numberwangPlugin) where

import Control.Applicative
import Control.Monad
import Data.Random
import Data.Random.Distribution.Poisson
import Lambdabot.Plugin
import Lambdabot.Util
import Numeric
import System.Random.Stateful (newIOGenM, newStdGen)


data NumberwangState = State
    { NumberwangState -> Int
nextCmd   :: !Int -- number of invocations of @numberwang before the next numberwang
    , NumberwangState -> Int
nextCon   :: !Int -- number of contextual occurrences of numbers before next numberwang
    }

cmdDist :: RVar Int
cmdDist :: RVar Int
cmdDist = forall b a. Distribution (Poisson b) a => b -> RVar a
poisson (Double
3.5 :: Double)

conDist :: RVar Int
conDist :: RVar Int
conDist = forall b a. Distribution (Poisson b) a => b -> RVar a
poisson (Double
32  :: Double)

numberwangPlugin :: Module NumberwangState
numberwangPlugin :: Module NumberwangState
numberwangPlugin = forall st. Module st
newModule
    { moduleDefState :: LB NumberwangState
moduleDefState = do
        IOGenM StdGen
g <- forall (m :: * -> *) g. MonadIO m => g -> m (IOGenM g)
newIOGenM forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
        forall (d :: * -> *) (m :: * -> *) t g.
(Sampleable d m t, StatefulGen g m) =>
g -> d t -> m t
sampleFrom IOGenM StdGen
g (Int -> Int -> NumberwangState
State forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RVar Int
cmdDist forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RVar Int
conDist)
    , moduleCmds :: ModuleT NumberwangState LB [Command (ModuleT NumberwangState LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"numberwang")
            { help :: Cmd (ModuleT NumberwangState LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"@numberwang <number>: Determines if it is Numberwang."
            , process :: String -> Cmd (ModuleT NumberwangState LB) ()
process = forall a (m :: * -> *).
(Num a, Ord a, MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> a -> Cmd m ()
doNumberwang Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
            }
        ]
    , contextual :: String -> Cmd (ModuleT NumberwangState LB) ()
contextual = forall a (m :: * -> *).
(Num a, Ord a, MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> a -> Cmd m ()
doNumberwang Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall t. RealFrac t => String -> [t]
numbers :: String -> [Double])
    }

numbers :: RealFrac t => String -> [t]
numbers :: forall t. RealFrac t => String -> [t]
numbers [] = []
numbers String
cs = case forall a. RealFrac a => ReadS a
readFloat String
cs of
    (t
n, String
rest):[(t, String)]
_ -> t
n forall a. a -> [a] -> [a]
: forall t. RealFrac t => String -> [t]
numbers String
rest
    [(t, String)]
_           -> forall t. RealFrac t => String -> [t]
numbers (forall a. [a] -> [a]
tail String
cs)

doNumberwang :: (Num a, Ord a, MonadLBState m, LBState m ~ NumberwangState) =>
                Bool -> a -> Cmd m ()
doNumberwang :: forall a (m :: * -> *).
(Num a, Ord a, MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> a -> Cmd m ()
doNumberwang Bool
cmd a
n
    | a
n forall a. Ord a => a -> a -> Bool
<= a
0    = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cmd forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"What number?"
    | Bool
otherwise = do
        Bool
isNumberwang <- forall (m :: * -> *).
(MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> Int -> m Bool
checkNumberwang Bool
cmd Int
1
        if Bool
isNumberwang
            then forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"That's Numberwang!"
            else forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cmd forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Sorry, that's not Numberwang."

withState :: (MonadLBState m, LBState m ~ NumberwangState) =>
             Bool -> (Int -> (Int -> m ()) -> RVar Int -> m a) -> m a
withState :: forall (m :: * -> *) a.
(MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> (Int -> (Int -> m ()) -> RVar Int -> m a) -> m a
withState Bool
True Int -> (Int -> m ()) -> RVar Int -> m a
f = forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState m
st LBState m -> m ()
setST ->
    Int -> (Int -> m ()) -> RVar Int -> m a
f (NumberwangState -> Int
nextCmd LBState m
st) (\Int
n -> LBState m -> m ()
setST LBState m
st {nextCmd :: Int
nextCmd = Int
n}) RVar Int
cmdDist
withState Bool
False Int -> (Int -> m ()) -> RVar Int -> m a
f = forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState m
st LBState m -> m ()
setST ->
    Int -> (Int -> m ()) -> RVar Int -> m a
f (NumberwangState -> Int
nextCon LBState m
st) (\Int
n -> LBState m -> m ()
setST LBState m
st {nextCon :: Int
nextCon = Int
n}) RVar Int
conDist

checkNumberwang :: (MonadLBState m, LBState m ~ NumberwangState) =>
                   Bool -> Int -> m Bool
checkNumberwang :: forall (m :: * -> *).
(MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> Int -> m Bool
checkNumberwang Bool
cmd Int
l = forall (m :: * -> *) a.
(MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> (Int -> (Int -> m ()) -> RVar Int -> m a) -> m a
withState Bool
cmd forall a b. (a -> b) -> a -> b
$ \ Int
n Int -> m ()
setN RVar Int
nDist -> do
    if Int
n forall a. Ord a => a -> a -> Bool
<= Int
l
        then do
            IOGenM StdGen
g <- forall (m :: * -> *) g. MonadIO m => g -> m (IOGenM g)
newIOGenM forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
            Int -> m ()
setN forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (d :: * -> *) (m :: * -> *) t g.
(Sampleable d m t, StatefulGen g m) =>
g -> d t -> m t
sampleFrom IOGenM StdGen
g RVar Int
nDist
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else do
            Int -> m ()
setN (Int
n forall a. Num a => a -> a -> a
- Int
l)
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False