-- Plugin.Source
-- Display source for specified identifiers
module Lambdabot.Plugin.Haskell.Source (sourcePlugin) where

import Lambdabot.Plugin
import Lambdabot.Util
import Control.Monad
import qualified Data.ByteString.Char8 as P
import qualified Data.Map as M

type Env = M.Map P.ByteString P.ByteString

sourcePlugin :: Module (M.Map P.ByteString P.ByteString)
sourcePlugin :: Module (Map ByteString ByteString)
sourcePlugin = Module (Map ByteString ByteString)
forall st. Module st
newModule
    { moduleCmds :: ModuleT
  (Map ByteString ByteString)
  LB
  [Command (ModuleT (Map ByteString ByteString) LB)]
moduleCmds = [Command (ModuleT (Map ByteString ByteString) LB)]
-> ModuleT
     (Map ByteString ByteString)
     LB
     [Command (ModuleT (Map ByteString ByteString) LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"src")
            { help :: Cmd (ModuleT (Map ByteString ByteString) LB) ()
help = String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
            , process :: String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
process = \String
key -> Cmd
  (ModuleT (Map ByteString ByteString) LB)
  (Map ByteString ByteString)
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS Cmd
  (ModuleT (Map ByteString ByteString) LB)
  (Map ByteString ByteString)
-> (Map ByteString ByteString
    -> Cmd (ModuleT (Map ByteString ByteString) LB) ())
-> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map ByteString ByteString
env -> case ByteString -> Map ByteString ByteString -> Maybe ByteString
fetch (String -> ByteString
P.pack String
key) Map ByteString ByteString
env of
                Maybe ByteString
_ | Map ByteString ByteString -> Bool
forall k a. Map k a -> Bool
M.null Map ByteString ByteString
env -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"No source in the environment yet"
                Maybe ByteString
_ |   String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
key -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
helpStr
                Maybe ByteString
Nothing        -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT (Map ByteString ByteString) LB) ())
-> (String -> String)
-> String
-> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Source not found. " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> Cmd (ModuleT (Map ByteString ByteString) LB) ())
-> Cmd (ModuleT (Map ByteString ByteString) LB) String
-> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd (ModuleT (Map ByteString ByteString) LB) String
forall (m :: * -> *). (MonadIO m, MonadConfig m) => m String
randomFailureMsg
                Just ByteString
s         -> String -> Cmd (ModuleT (Map ByteString ByteString) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (ByteString -> String
P.unpack ByteString
s)
            }
        ]

    -- all the hard work is done to build the src map.
    -- uses a slightly custom Map format
    , moduleSerialize :: Maybe (Serial (Map ByteString ByteString))
moduleSerialize = Serial (Map ByteString ByteString)
-> Maybe (Serial (Map ByteString ByteString))
forall a. a -> Maybe a
Just (Serial (Map ByteString ByteString)
 -> Maybe (Serial (Map ByteString ByteString)))
-> ((ByteString -> Map ByteString ByteString)
    -> Serial (Map ByteString ByteString))
-> (ByteString -> Map ByteString ByteString)
-> Maybe (Serial (Map ByteString ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Map ByteString ByteString)
-> Serial (Map ByteString ByteString)
forall b. (ByteString -> b) -> Serial b
readOnly ((ByteString -> Map ByteString ByteString)
 -> Maybe (Serial (Map ByteString ByteString)))
-> (ByteString -> Map ByteString ByteString)
-> Maybe (Serial (Map ByteString ByteString))
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> Map ByteString ByteString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ByteString, ByteString)] -> Map ByteString ByteString)
-> (ByteString -> [(ByteString, ByteString)])
-> ByteString
-> Map ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> (ByteString, ByteString))
-> [[ByteString]] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map [ByteString] -> (ByteString, ByteString)
pair ([[ByteString]] -> [(ByteString, ByteString)])
-> (ByteString -> [[ByteString]])
-> ByteString
-> [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [[ByteString]]
splat ([ByteString] -> [[ByteString]])
-> (ByteString -> [ByteString]) -> ByteString -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
P.lines
    }
        where
            pair :: [ByteString] -> (ByteString, ByteString)
pair (ByteString
a:[ByteString]
b) = (ByteString
a, [ByteString] -> ByteString
P.unlines [ByteString]
b)
            pair [ByteString]
_     = String -> (ByteString, ByteString)
forall a. HasCallStack => String -> a
error String
"Source Plugin error: not a pair"
            splat :: [ByteString] -> [[ByteString]]
splat []   = []
            splat [ByteString]
s    = [ByteString]
a [ByteString] -> [[ByteString]] -> [[ByteString]]
forall a. a -> [a] -> [a]
: [ByteString] -> [[ByteString]]
splat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail [ByteString]
b) where ([ByteString]
a,[ByteString]
b) = (ByteString -> Bool)
-> [ByteString] -> ([ByteString], [ByteString])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ByteString -> Bool
P.null [ByteString]
s

fetch :: P.ByteString -> Env -> Maybe P.ByteString
fetch :: ByteString -> Map ByteString ByteString -> Maybe ByteString
fetch ByteString
x Map ByteString ByteString
m = ByteString -> Map ByteString ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ByteString
x Map ByteString ByteString
m Maybe ByteString -> Maybe ByteString -> Maybe ByteString
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
            ByteString -> Map ByteString ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ([ByteString] -> ByteString
P.concat [Char -> ByteString
P.singleton Char
'(', ByteString
x, Char -> ByteString
P.singleton Char
')']) Map ByteString ByteString
m

helpStr :: String
helpStr :: String
helpStr = String
"src <id>. Display the implementation of a standard function"