    {-# LANGUAGE PatternGuards #-}
    -- Copyright (c) 2004-6 Don Stewart - http://www.cse.unsw.edu.au/~dons
    -- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)
    --
    -- | Interface to /aspell/, an open source spelling checker, from a
    -- suggestion by Kai Engelhardt. Requires you to install aspell.
    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 = Module Bool
    forall st. Module st
    newModule
        { moduleCmds = return
            [ (command "spell")
                { help = say helpStr
                , process = doSpell
                }
            , (command "spell-all")
                { help = say helpStr
                , process = spellAll
                }
            , (command "nazi-on")
                { privileged = True
                , help = say helpStr
                , process = const (nazi True)
                }
            , (command "nazi-off")
                { privileged = True
                , help = say helpStr
                , process = const (nazi False)
                }
            ]
        , moduleDefState = return False

        , contextual = \String
    txt -> do
            alive <- Cmd (ModuleT Bool LB) Bool
    Cmd (ModuleT Bool LB) (LBState (Cmd (ModuleT Bool LB)))
    forall (m :: * -> *). MonadLBState m => m (LBState m)
    readMS
            binary <- getConfig aspellBinary
            if alive then io (spellingNazi binary txt) >>= mapM_ say
                     else return ()
        }

    helpStr :: String
    helpStr :: String
    helpStr = String
    "spell <word>. Show spelling of word"

    doSpell :: [Char] -> Cmd Spell ()
    doSpell :: String -> Cmd (ModuleT Bool LB) ()
    doSpell [] = String -> Cmd (ModuleT Bool LB) ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "No word to spell."
    doSpell String
    s  = do
        binary <- Config String -> Cmd (ModuleT Bool LB) String
    forall a. Config a -> Cmd (ModuleT Bool LB) a
    forall (m :: * -> *) a. MonadConfig m => Config a -> m a
    getConfig Config String
    aspellBinary
        (say . showClean . take 5) =<< (io (spell binary s))

    spellAll :: [Char] -> Cmd Spell ()
    spellAll :: String -> Cmd (ModuleT Bool LB) ()
    spellAll [] = String -> Cmd (ModuleT Bool LB) ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "No phrase to spell."
    spellAll String
    s  = do
        binary <- Config String -> Cmd (ModuleT Bool LB) String
    forall a. Config a -> Cmd (ModuleT Bool LB) a
    forall (m :: * -> *) a. MonadConfig m => Config a -> m a
    getConfig Config String
    aspellBinary
        liftIO (spellingNazi binary s) >>= mapM_ say

    nazi :: Bool -> Cmd (ModuleT Bool LB) ()
    nazi :: Bool -> Cmd (ModuleT Bool LB) ()
    nazi Bool
    True  = ModuleT Bool LB () -> Cmd (ModuleT Bool LB) ()
    forall (m :: * -> *) a. Monad m => m a -> Cmd m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift ModuleT Bool LB ()
    on  Cmd (ModuleT Bool LB) ()
    -> Cmd (ModuleT Bool LB) () -> Cmd (ModuleT Bool LB) ()
    forall a b.
    Cmd (ModuleT Bool LB) a
    -> Cmd (ModuleT Bool LB) b -> Cmd (ModuleT Bool LB) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> Cmd (ModuleT Bool LB) ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "Spelling nazi engaged."
    nazi Bool
    False = ModuleT Bool LB () -> Cmd (ModuleT Bool LB) ()
    forall (m :: * -> *) a. Monad m => m a -> Cmd m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift ModuleT Bool LB ()
    off Cmd (ModuleT Bool LB) ()
    -> Cmd (ModuleT Bool LB) () -> Cmd (ModuleT Bool LB) ()
    forall a b.
    Cmd (ModuleT Bool LB) a
    -> Cmd (ModuleT Bool LB) b -> Cmd (ModuleT Bool LB) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> Cmd (ModuleT Bool LB) ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "Spelling nazi disengaged."

    on :: Spell ()
    on :: ModuleT Bool LB ()
    on  = LBState (ModuleT Bool LB) -> ModuleT Bool LB ()
    forall (m :: * -> *). MonadLBState m => LBState m -> m ()
    writeMS Bool
    LBState (ModuleT Bool LB)
    True

    off :: Spell ()
    off :: ModuleT Bool LB ()
    off = LBState (ModuleT Bool LB) -> ModuleT Bool LB ()
    forall (m :: * -> *). MonadLBState m => LBState m -> m ()
    writeMS Bool
    LBState (ModuleT Bool LB)
    False

    args :: [String]
    args :: [String]
    args = [String
    "pipe"]

    --
    -- | Find the first misspelled word in the input line, and return plausible
    -- output.
    --
    spellingNazi :: String -> String -> IO [String]
    spellingNazi :: String -> String -> IO [String]
    spellingNazi String
    binary String
    lin = ([[String]] -> [String]) -> IO [[String]] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([String] -> [String])
    -> ([[String]] -> [String]) -> [[String]] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat) ((String -> IO [String]) -> [String] -> IO [[String]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM String -> IO [String]
    correct (String -> [String]
    words String
    lin))
        where correct :: String -> IO [String]
    correct String
    word = do
                var <- Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take Int
    5 ([String] -> [String]) -> IO [String] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` String -> String -> IO [String]
    spell String
    binary String
    word
                return $ if null var || any (equating' (map toLower) word) var
                    then []
                    else ["Did you mean " ++ listToStr "or" var ++ "?"]
              equating' :: (t -> a) -> t -> t -> Bool
    equating' t -> a
    f t
    x t
    y = t -> a
    f t
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == t -> a
    f t
    y
    --
    -- | Return a list of possible spellings for a word
    -- 'String' is a word to check the spelling of.
    --
    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
        (_,out,err) <- String -> [String] -> String -> IO (ExitCode, String, String)
    readProcessWithExitCode String
    binary ([String]
    args[String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++[String]
    ex) String
    word
        let o = [String] -> Maybe [String] -> [String]
    forall a. a -> Maybe a -> a
    fromMaybe [String
    word] (([String] -> Maybe [String]
    clean_ ([String] -> Maybe [String])
    -> (String -> [String]) -> String -> Maybe [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines) String
    out)
            e = [String] -> Maybe [String] -> [String]
    forall a. a -> Maybe a -> a
    fromMaybe [String]
    e      (([String] -> Maybe [String]
    clean_ ([String] -> Maybe [String])
    -> (String -> [String]) -> String -> Maybe [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines) String
    err)
        return $ case () of {()
    _
            | [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    o Bool -> Bool -> Bool
    && [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    e -> []
            | [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    o           -> [String]
    e
            | Bool
    otherwise        -> [String]
    o
        }

    --
    -- Parse the output of aspell (would probably work for ispell too)
    --
    clean_ :: [String] -> Maybe [String]
    clean_ :: [String] -> Maybe [String]
    clean_ ((Char
    '@':Char
    '(':Char
    '#':Char
    ')':String
    _):[String]
    rest) = [String] -> Maybe [String]
    clean' [String]
    rest -- drop header
    clean_ [String]
    s = [String] -> Maybe [String]
    clean' [String]
    s                             -- no header for some reason

    --
    -- Parse rest of aspell output.
    --
    -- Grammar is:
    --      OK          ::=  *
    --      Suggestions ::= & <original> <count> <offset>: <miss>, <miss>, ...
    --      None        ::= # <original> <offset>
    --
    clean' :: [String] -> Maybe [String]
    clean' :: [String] -> Maybe [String]
    clean' ((Char
    '*':String
    _):[String]
    _)    = Maybe [String]
    forall a. Maybe a
    Nothing                          -- correct spelling
    clean' ((Char
    '#':String
    _):[String]
    _)    = [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just []                          -- no match
    clean' ((Char
    '&':String
    rest):[String]
    _) = [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
    forall a b. (a -> b) -> a -> b
    $ String -> String -> [String]
    forall a. Eq a => [a] -> [a] -> [[a]]
    splitOn String
    ", " (String -> String
    clean'' String
    rest) -- suggestions
    clean' [String]
    _              = [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just []                          -- not sure

    clean'' :: String -> String
    clean'' :: String -> String
    clean'' String
    s = String
    -> (MatchResult String -> String)
    -> Maybe (MatchResult String)
    -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    s MatchResult String -> String
    forall a. MatchResult a -> a
    mrAfter (String
    s String -> String -> Maybe (MatchResult String)
    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
    "[^:]*: "    -- drop header