lambdabot-4.1: scripts/BotPP.hs

{-# OPTIONS -O -funbox-strict-fields #-}
-- Copyright (c) 2006 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

--
-- Implements a preprocessor for plugins, filling in commonly required
-- syntax.
--
-- Currently only useful for plugins that only:
--  import Plugin
-- and have () for state.  
--
-- Also used to generate the modules list in Modules.hs
--

import System.Environment
import Data.Char
import Data.List

import Data.ByteString.Char8 (pack, ByteString)
import qualified Data.ByteString.Char8 as B -- crank it up, yeah!

main = do
    -- putStr "BotPP called with args: ";  print =<< getArgs
    [orig,i,o] <- getArgs
    let basename = baseName orig
    -- putStr "basename = "; print basename
    B.readFile i >>= \l -> B.writeFile o $ expand (B.length l) 0 basename l

baseName :: FilePath -> FilePath
baseName s = base 
    where
    rfile = takeWhile (not . (`elem` "/\\")) (reverse s)
    base  = takeWhile (/='.') (reverse rfile)

--
-- tricksy non-copying implementation.
--
expand :: Int -> Int -> String -> ByteString -> ByteString
expand l n basename xs
    | n `seq` xs `seq` False               = undefined -- strict
    | l == n                               = xs        -- not found
    | pLUGIN  `B.isPrefixOf` (B.drop n xs) = B.concat $ pref : render  name  ++ [B.tail rest]
    | mODULES `B.isPrefixOf` (B.drop n xs) = B.concat $ pref : modules basename name' ++ [B.tail rest']
    | otherwise                            = expand l (n+1) basename xs

    where pref         = B.take n xs    -- accumulating an offset

          pLUGIN       = pack "PLUGIN "
          (name, rest) = B.break (=='\n') (B.drop (n+B.length pLUGIN) xs)

          mODULES      = pack "MODULES "
          (name', rest') = B.break (=='\n') (B.drop (n+B.length mODULES) xs)

--
-- render the plugin boiler plate
--
render :: ByteString -> [ByteString]
render name =
    pack "newtype "  : name :
    pack "Module = " : name : pack "Module () \n\ 
    \\n\ 
    \theModule :: MODULE                            \n\ 
    \theModule = MODULE $ " : name : pack "Module ()       \n" : []

--
-- Collect all the plugin names, and generate the Modules.hs file
--
modules :: String -> ByteString -> [ByteString]
modules basename s =
    [pack "module ", pack basename, pack " (modulesInfo) where\n"
    ,pack "import Lambdabot\n"
    ,pack "\n"]
    ++ (concatMap importify statics) ++
    [pack "modulesInfo :: (LB (), [String])\n"
    ,pack "modulesInfo = (loadStaticModules, plugins)\n"
    ,pack "loadStaticModules :: LB ()\n"
    ,pack "loadStaticModules = do\n"]
    ++ (concatMap instalify statics) ++
    [pack "plugins :: [String]\n"
    ,pack "plugins = ["]
    ++ ((concat . (intersperse [pack ","]) . map pluginify) plugins) ++
    [pack "]\n"]

    where ms  = filter nonWhitespace $ B.split ' ' s

          statics = sort statics'
          plugins = sort plugins'

          (statics', rest) = break ((==)(pack ":")) ms
          plugins' = drop 1 rest

          importify x = [pack "import qualified Plugin.", x, B.singleton '\n']
          instalify x = [pack "  ircInstallModule Plugin.",x
                        ,pack ".theModule \""
                        ,B.map toLower x
                        , pack "\"\n"]
          pluginify x = [pack "\""
                        ,B.map toLower x
                        ,pack "\""]
                               

          nonWhitespace s 
              | s == pack ""   = False
              | s == pack "\n" = False
              | otherwise      = True