-- | Hackish Haddock module.
module Lambdabot.Plugin.Haskell.Haddock (haddockPlugin) where

import Lambdabot.Plugin

import qualified Data.ByteString.Char8 as P
import Data.List
import qualified Data.Map as M

type HaddockState = M.Map P.ByteString [P.ByteString]
type Haddock = ModuleT HaddockState LB

haddockPlugin :: Module HaddockState
haddockPlugin :: Module HaddockState
haddockPlugin = Module HaddockState
forall st. Module st
newModule
    { moduleCmds :: ModuleT HaddockState LB [Command (ModuleT HaddockState LB)]
moduleCmds = [Command (ModuleT HaddockState LB)]
-> ModuleT HaddockState LB [Command (ModuleT HaddockState LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"index")
            { help :: Cmd (ModuleT HaddockState LB) ()
help = String -> Cmd (ModuleT HaddockState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"index <ident>. Returns the Haskell modules in which <ident> is defined"
            , process :: String -> Cmd (ModuleT HaddockState LB) ()
process = String -> Cmd (ModuleT HaddockState LB) ()
doHaddock
            }
        ]
        
    , moduleDefState :: LB HaddockState
moduleDefState  = HaddockState -> LB HaddockState
forall (m :: * -> *) a. Monad m => a -> m a
return HaddockState
forall k a. Map k a
M.empty
    , moduleSerialize :: Maybe (Serial HaddockState)
moduleSerialize = Serial HaddockState -> Maybe (Serial HaddockState)
forall a. a -> Maybe a
Just ((ByteString -> HaddockState) -> Serial HaddockState
forall b. (ByteString -> b) -> Serial b
readOnly ByteString -> HaddockState
forall t. Packable t => ByteString -> t
readPacked)
    }

doHaddock :: String -> Cmd Haddock ()
doHaddock :: String -> Cmd (ModuleT HaddockState LB) ()
doHaddock String
k = do
    HaddockState
m <- Cmd (ModuleT HaddockState LB) HaddockState
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    String -> Cmd (ModuleT HaddockState LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT HaddockState LB) ())
-> String -> Cmd (ModuleT HaddockState LB) ()
forall a b. (a -> b) -> a -> b
$ String -> ([ByteString] -> String) -> Maybe [ByteString] -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"bzzt"
        (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate (String
", ") ([String] -> String)
-> ([ByteString] -> [String]) -> [ByteString] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
P.unpack)
        (ByteString -> HaddockState -> Maybe [ByteString]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ByteString -> ByteString
stripPs (String -> ByteString
P.pack String
k)) HaddockState
m)

-- make \@index ($) work.
stripPs :: P.ByteString -> P.ByteString
stripPs :: ByteString -> ByteString
stripPs = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
P.spanEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
')') (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
P.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'(')