-- Copyright (c) 2006 Jason Dagit - http://www.codersbase.com/
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

-- | A plugin for the Haskell interpreter for the brainf*ck language
-- http://www.muppetlabs.com/~breadbox/bf/
module Lambdabot.Plugin.Novelty.BF (bfPlugin) where

import Lambdabot.Config.Novelty
import Lambdabot.Plugin
import Lambdabot.Util.Process

import Data.Char
import Text.Regex.TDFA

bfPlugin :: Module ()
bfPlugin :: Module ()
bfPlugin = Module ()
forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"bf")
            { help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"bf <expr>. Evaluate a brainf*ck expression"
            , process :: String -> Cmd (ModuleT () LB) ()
process = \String
msg -> do
                String
bf <- Config String -> Cmd (ModuleT () LB) String
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config String
bfBinary
                IO String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). MonadIO m => IO String -> Cmd m ()
ios80 (String -> String -> (String -> String) -> IO String
run String
bf String
msg String -> String
scrub)
            }
        ]
    }

-- Clean up output
scrub :: String -> String
scrub :: String -> String
scrub = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
6 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
cleanit ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

cleanit :: String -> String
cleanit :: String -> String
cleanit String
s | String
s String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
terminated   = String
"Terminated\n"
          | Bool
otherwise         = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
printable String
s
    where terminated :: String
terminated = String
"waitForProc"
          -- the printable ascii chars are in the range [32 .. 126]
          -- according to wikipedia:
          -- http://en.wikipedia.org/wiki/ASCII#ASCII_printable_characters
          printable :: Char -> Bool
printable Char
x = Int
31 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Char -> Int
ord Char
x Bool -> Bool -> Bool
&& Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
127