{-# LANGUAGE PatternGuards #-}
module Lambdabot.Plugin.Reference.Spell (spellPlugin) where
import Lambdabot.Config.Reference
import Lambdabot.Plugin
import Lambdabot.Util
import Control.Monad.Trans
import Data.Char
import Data.List.Split
import Data.Maybe
import System.Process
import Text.Regex.TDFA
type Spell = ModuleT Bool LB
spellPlugin :: Module Bool
spellPlugin :: Module Bool
spellPlugin = forall st. Module st
newModule
{ moduleCmds :: ModuleT Bool LB [Command (ModuleT Bool LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
[ (String -> Command Identity
command String
"spell")
{ help :: Cmd (ModuleT Bool LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
, process :: String -> Cmd (ModuleT Bool LB) ()
process = String -> Cmd (ModuleT Bool LB) ()
doSpell
}
, (String -> Command Identity
command String
"spell-all")
{ help :: Cmd (ModuleT Bool LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
, process :: String -> Cmd (ModuleT Bool LB) ()
process = String -> Cmd (ModuleT Bool LB) ()
spellAll
}
, (String -> Command Identity
command String
"nazi-on")
{ privileged :: Bool
privileged = Bool
True
, help :: Cmd (ModuleT Bool LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
, process :: String -> Cmd (ModuleT Bool LB) ()
process = forall a b. a -> b -> a
const (Bool -> Cmd (ModuleT Bool LB) ()
nazi Bool
True)
}
, (String -> Command Identity
command String
"nazi-off")
{ privileged :: Bool
privileged = Bool
True
, help :: Cmd (ModuleT Bool LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
, process :: String -> Cmd (ModuleT Bool LB) ()
process = forall a b. a -> b -> a
const (Bool -> Cmd (ModuleT Bool LB) ()
nazi Bool
False)
}
]
, moduleDefState :: LB Bool
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
, contextual :: String -> Cmd (ModuleT Bool LB) ()
contextual = \String
txt -> do
Bool
alive <- forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
String
binary <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config String
aspellBinary
if Bool
alive then forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> String -> IO [String]
spellingNazi String
binary String
txt) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). Monad m => String -> Cmd m ()
say
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
}
helpStr :: String
helpStr :: String
helpStr = String
"spell <word>. Show spelling of word"
doSpell :: [Char] -> Cmd Spell ()
doSpell :: String -> Cmd (ModuleT Bool LB) ()
doSpell [] = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"No word to spell."
doSpell String
s = do
String
binary <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config String
aspellBinary
(forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => [a] -> String
showClean forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
5) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> String -> IO [String]
spell String
binary String
s))
spellAll :: [Char] -> Cmd Spell ()
spellAll :: String -> Cmd (ModuleT Bool LB) ()
spellAll [] = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"No phrase to spell."
spellAll String
s = do
String
binary <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config String
aspellBinary
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO [String]
spellingNazi String
binary String
s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). Monad m => String -> Cmd m ()
say
nazi :: Bool -> Cmd (ModuleT Bool LB) ()
nazi :: Bool -> Cmd (ModuleT Bool LB) ()
nazi Bool
True = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Spell ()
on forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Spelling nazi engaged."
nazi Bool
False = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Spell ()
off forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Spelling nazi disengaged."
on :: Spell ()
on :: Spell ()
on = forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS Bool
True
off :: Spell ()
off :: Spell ()
off = forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS Bool
False
args :: [String]
args :: [String]
args = [String
"pipe"]
spellingNazi :: String -> String -> IO [String]
spellingNazi :: String -> String -> IO [String]
spellingNazi String
binary String
lin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [String]
correct (String -> [String]
words String
lin))
where correct :: String -> IO [String]
correct String
word = do
[String]
var <- forall a. Int -> [a] -> [a]
take Int
5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> String -> IO [String]
spell String
binary String
word
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
var Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall {a} {t}. Eq a => (t -> a) -> t -> t -> Bool
equating' (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) String
word) [String]
var
then []
else [String
"Did you mean " forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
listToStr String
"or" [String]
var forall a. [a] -> [a] -> [a]
++ String
"?"]
equating' :: (t -> a) -> t -> t -> Bool
equating' t -> a
f t
x t
y = t -> a
f t
x forall a. Eq a => a -> a -> Bool
== t -> a
f t
y
spell :: String -> String -> IO [String]
spell :: String -> String -> IO [String]
spell String
binary String
word = String -> String -> [String] -> IO [String]
spellWithArgs String
binary String
word []
spellWithArgs :: String -> String -> [String] -> IO [String]
spellWithArgs :: String -> String -> [String] -> IO [String]
spellWithArgs String
binary String
word [String]
ex = do
(ExitCode
_,String
out,String
err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
binary ([String]
argsforall a. [a] -> [a] -> [a]
++[String]
ex) String
word
let o :: [String]
o = forall a. a -> Maybe a -> a
fromMaybe [String
word] (([String] -> Maybe [String]
clean_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) String
out)
e :: [String]
e = forall a. a -> Maybe a -> a
fromMaybe [String]
e (([String] -> Maybe [String]
clean_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) String
err)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case () of {()
_
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
o Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
e -> []
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
o -> [String]
e
| Bool
otherwise -> [String]
o
}
clean_ :: [String] -> Maybe [String]
clean_ :: [String] -> Maybe [String]
clean_ ((Char
'@':Char
'(':Char
'#':Char
')':String
_):[String]
rest) = [String] -> Maybe [String]
clean' [String]
rest
clean_ [String]
s = [String] -> Maybe [String]
clean' [String]
s
clean' :: [String] -> Maybe [String]
clean' :: [String] -> Maybe [String]
clean' ((Char
'*':String
_):[String]
_) = forall a. Maybe a
Nothing
clean' ((Char
'#':String
_):[String]
_) = forall a. a -> Maybe a
Just []
clean' ((Char
'&':String
rest):[String]
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
", " (String -> String
clean'' String
rest)
clean' [String]
_ = forall a. a -> Maybe a
Just []
clean'' :: String -> String
clean'' :: String -> String
clean'' String
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
s forall a. MatchResult a -> a
mrAfter (String
s forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ String
pat)
where pat :: String
pat = String
"[^:]*: "