    {-# 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 (3.5 :: Double)

    conDist :: RVar Int
    conDist :: RVar Int
    conDist = Double -> RVar Int
    forall b a. Distribution (Poisson b) a => b -> RVar a
    poisson (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 "numberwang")
                { help :: Cmd (ModuleT NumberwangState LB) ()
    help = String -> Cmd (ModuleT NumberwangState LB) ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say "@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 cs :: String
    cs = case ReadS t
    forall a. RealFrac a => ReadS a
    readFloat String
    cs of
        (n :: t
    n, rest :: String
    rest):_ -> t
    n t -> [t] -> [t]
    forall a. a -> [a] -> [a]
    : String -> [t]
    forall t. RealFrac t => String -> [t]
    numbers String
    rest
        _           -> 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 cmd :: Bool
    cmd n :: a
    n
        | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 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 "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 1
            if Bool
    isNumberwang
                then String -> Cmd m ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say "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 "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 True f :: 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
    $ \st :: LBState m
    st setST :: LBState m -> m ()
    setST ->
        Int -> (Int -> m ()) -> RVar Int -> m a
    f (NumberwangState -> Int
    nextCmd LBState m
    NumberwangState
    st) (\n :: Int
    n -> LBState m -> m ()
    setST LBState m
    NumberwangState
    st {nextCmd :: Int
    nextCmd = Int
    n}) RVar Int
    cmdDist
    withState False f :: 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
    $ \st :: LBState m
    st setST :: LBState m -> m ()
    setST ->
        Int -> (Int -> m ()) -> RVar Int -> m a
    f (NumberwangState -> Int
    nextCon LBState m
    NumberwangState
    st) (\n :: 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 cmd :: Bool
    cmd l :: 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
    $ \ n :: Int
    n setN :: Int -> m ()
    setN nDist :: 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