    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}

    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 = 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 = do
            g <- newIOGenM =<< newStdGen
            sampleFrom g (State <$> cmdDist <*> conDist)
        , moduleCmds = return
            [ (command "numberwang")
                { help = say "@numberwang <number>: Determines if it is Numberwang."
                , process = doNumberwang True . length . words
                }
            ]
        , contextual = doNumberwang False . length . (numbers :: String -> [Double])
        }

    numbers :: RealFrac t => String -> [t]
    numbers :: forall t. RealFrac t => 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. HasCallStack => [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 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 :: 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 = (LBState m -> (LBState m -> m ()) -> m a) -> m a
    forall a. (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
    st {nextCmd = 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 a. (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
    st {nextCon = 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 = 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
                IOGenM StdGen
    g <- StdGen -> m (IOGenM StdGen)
    forall (m :: * -> *) g. MonadIO m => g -> m (IOGenM g)
    newIOGenM (StdGen -> m (IOGenM StdGen)) -> m StdGen -> m (IOGenM StdGen)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< m StdGen
    forall (m :: * -> *). MonadIO m => m StdGen
    newStdGen
                Int -> m ()
    setN (Int -> m ()) -> m Int -> m ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IOGenM StdGen -> RVar Int -> m Int
    forall g. StatefulGen g m => g -> RVar Int -> m Int
    forall (d :: * -> *) (m :: * -> *) t g.
    (Sampleable d m t, StatefulGen g m) =>
    g -> d t -> m t
    sampleFrom IOGenM StdGen
    g RVar Int
    nDist
                Bool -> m Bool
    forall a. a -> m a
    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 a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False