{-# 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 Numeric


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 = Double -> RVar Int
forall b a. Distribution (Poisson b) a => b -> RVar a
poisson (Double
3.5 :: Double)

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

numberwangPlugin :: Module NumberwangState
numberwangPlugin :: Module NumberwangState
numberwangPlugin = Module NumberwangState
forall st. Module st
newModule
    { moduleDefState :: LB NumberwangState
moduleDefState = RVarT Identity NumberwangState -> LB NumberwangState
forall (d :: * -> *) (m :: * -> *) t.
(Sampleable d m t, MonadRandom m) =>
d t -> m t
sample (Int -> Int -> NumberwangState
State (Int -> Int -> NumberwangState)
-> RVar Int -> RVarT Identity (Int -> NumberwangState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RVar Int
cmdDist RVarT Identity (Int -> NumberwangState)
-> RVar Int -> RVarT Identity NumberwangState
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 = [Command (ModuleT NumberwangState LB)]
-> ModuleT
     NumberwangState LB [Command (ModuleT NumberwangState LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"numberwang")
            { help :: Cmd (ModuleT NumberwangState LB) ()
help = String -> Cmd (ModuleT NumberwangState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"@numberwang <number>: Determines if it is Numberwang."
            , process :: String -> Cmd (ModuleT NumberwangState LB) ()
process = Bool -> Int -> Cmd (ModuleT NumberwangState LB) ()
forall a (m :: * -> *).
(Num a, Ord a, MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> a -> Cmd m ()
doNumberwang Bool
True (Int -> Cmd (ModuleT NumberwangState LB) ())
-> (String -> Int) -> String -> Cmd (ModuleT NumberwangState LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> (String -> [String]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
            }
        ]
    , contextual :: String -> Cmd (ModuleT NumberwangState LB) ()
contextual = Bool -> Int -> Cmd (ModuleT NumberwangState LB) ()
forall a (m :: * -> *).
(Num a, Ord a, MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> a -> Cmd m ()
doNumberwang Bool
False (Int -> Cmd (ModuleT NumberwangState LB) ())
-> (String -> Int) -> String -> Cmd (ModuleT NumberwangState LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> (String -> [Double]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [Double]
forall t. RealFrac t => String -> [t]
numbers :: String -> [Double])
    }

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

doNumberwang :: (Num a, Ord a, MonadLBState m, LBState m ~ NumberwangState) =>
                Bool -> a -> Cmd m ()
doNumberwang :: Bool -> a -> Cmd m ()
doNumberwang Bool
cmd a
n
    | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0    = Bool -> Cmd m () -> Cmd m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cmd (Cmd m () -> Cmd m ()) -> Cmd m () -> Cmd m ()
forall a b. (a -> b) -> a -> b
$ String -> Cmd m ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"What number?"
    | Bool
otherwise = do
        Bool
isNumberwang <- Bool -> Int -> Cmd m Bool
forall (m :: * -> *).
(MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> Int -> m Bool
checkNumberwang Bool
cmd Int
1
        if Bool
isNumberwang
            then String -> Cmd m ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"That's Numberwang!"
            else Bool -> Cmd m () -> Cmd m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cmd (Cmd m () -> Cmd m ()) -> Cmd m () -> Cmd m ()
forall a b. (a -> b) -> a -> b
$ String -> Cmd m ()
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 :: Bool -> (Int -> (Int -> m ()) -> RVar Int -> m a) -> m a
withState Bool
True Int -> (Int -> m ()) -> RVar Int -> m a
f = (LBState m -> (LBState m -> m ()) -> m a) -> m a
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState m -> (LBState m -> m ()) -> m a) -> m a)
-> (LBState m -> (LBState m -> m ()) -> m a) -> m a
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
NumberwangState
st) (\Int
n -> LBState m -> m ()
setST LBState m
NumberwangState
st {nextCmd :: Int
nextCmd = Int
n}) RVar Int
cmdDist
withState Bool
False Int -> (Int -> m ()) -> RVar Int -> m a
f = (LBState m -> (LBState m -> m ()) -> m a) -> m a
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState m -> (LBState m -> m ()) -> m a) -> m a)
-> (LBState m -> (LBState m -> m ()) -> m a) -> m a
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
NumberwangState
st) (\Int
n -> LBState m -> m ()
setST LBState m
NumberwangState
st {nextCon :: Int
nextCon = Int
n}) RVar Int
conDist

checkNumberwang :: (MonadLBState m, LBState m ~ NumberwangState) =>
                   Bool -> Int -> m Bool
checkNumberwang :: Bool -> Int -> m Bool
checkNumberwang Bool
cmd Int
l = Bool -> (Int -> (Int -> m ()) -> RVar Int -> m Bool) -> m Bool
forall (m :: * -> *) a.
(MonadLBState m, LBState m ~ NumberwangState) =>
Bool -> (Int -> (Int -> m ()) -> RVar Int -> m a) -> m a
withState Bool
cmd ((Int -> (Int -> m ()) -> RVar Int -> m Bool) -> m Bool)
-> (Int -> (Int -> m ()) -> RVar Int -> m Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ \ Int
n Int -> m ()
setN RVar Int
nDist -> do
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
l
        then do
            Int -> m ()
setN (Int -> m ()) -> m Int -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LB Int -> m Int
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (RVar Int -> LB Int
forall (d :: * -> *) (m :: * -> *) t.
(Sampleable d m t, MonadRandom m) =>
d t -> m t
sample RVar Int
nDist)
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else do
            Int -> m ()
setN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False