-- | Look up sequences in the Online Encyclopedia of Integer Sequences
--   Based on the Math.OEIS library
module Lambdabot.Plugin.Reference.OEIS (oeisPlugin) where

import Lambdabot.Plugin

import Math.OEIS
import Data.Char

oeisPlugin :: Module ()
oeisPlugin :: Module ()
oeisPlugin = forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"oeis")
            { aliases :: [String]
aliases = [String
"sequence"]
            , help :: Cmd (ModuleT () LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"oeis <sequence>. Look up a sequence in the Online Encyclopedia of Integer Sequences"
            , process :: String -> Cmd (ModuleT () LB) ()
process = forall (m :: * -> *). MonadIO m => IO String -> Cmd m ()
ios80 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
lookupOEIS'
            }
        ]
    }

lookupOEIS' :: String -> IO String
lookupOEIS' :: String -> IO String
lookupOEIS' String
a = do
    let a' :: String
a' = String -> String
commas forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ String
a
    Maybe OEISSequence
x <- String -> IO (Maybe OEISSequence)
searchSequence_IO String
a'
    case Maybe OEISSequence
x of
        Maybe OEISSequence
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"Sequence not found."
        Just OEISSequence
s  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
            forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
"https://oeis.org/" forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take Int
1 (OEISSequence -> [String]
catalogNums OEISSequence
s)) forall a. [a] -> [a] -> [a]
++
            Char
' ' forall a. a -> [a] -> [a]
: OEISSequence -> String
description OEISSequence
s,
            forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ OEISSequence -> SequenceData
sequenceData OEISSequence
s]
  where
    commas :: String -> String
commas []                     = []
    commas (Char
x:Char
' ':String
xs) | Char -> Bool
isDigit Char
x = Char
x forall a. a -> [a] -> [a]
: Char
',' forall a. a -> [a] -> [a]
: String -> String
commas String
xs
    commas (Char
x:String
xs)                 = Char
x forall a. a -> [a] -> [a]
: String -> String
commas String
xs