module Lambdabot.Plugin.Haskell.Check (checkPlugin) where
import Lambdabot.Plugin
import Lambdabot.Plugin.Haskell.Eval (runGHC)
import qualified Language.Haskell.Exts.Simple as Hs
import Codec.Binary.UTF8.String
checkPlugin :: Module ()
checkPlugin :: Module ()
checkPlugin = Module ()
forall st. Module st
newModule
{ moduleCmds = return
[ (command "check")
{ help = do
say "check <expr>"
say "You have QuickCheck and 3 seconds. Prove something."
, process = lim80 . check
}
]
}
check :: MonadLB m => String -> m String
check :: forall (m :: * -> *). MonadLB m => String -> m String
check String
src =
case String -> ParseResult Exp
Hs.parseExp (String -> String
decodeString String
src) of
Hs.ParseFailed SrcLoc
l String
e -> String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcLoc -> String
forall a. Pretty a => a -> String
Hs.prettyPrint SrcLoc
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: String
e)
Hs.ParseOk{} -> String -> String
postProcess (String -> String) -> m String -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> m String
forall (m :: * -> *). MonadLB m => String -> m String
runGHC (String
"text (myquickcheck (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
src String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"))")
postProcess :: String -> String
postProcess String
xs =
let ([String]
first, [String]
rest) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) (String -> [String]
lines String
xs))
in [String] -> String
unlines ([String]
first [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String] -> String
unwords [String]
rest | Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
rest)])