-- Copyright (c) 6 DonStewart - http://www.cse.unsw.edu.au/~dons
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

-- | Test a property with QuickCheck
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 = forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"check")
            { help :: Cmd (ModuleT () LB) ()
help = do
                forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"check <expr>"
                forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"You have QuickCheck and 3 seconds. Prove something."
            , process :: String -> Cmd (ModuleT () LB) ()
process = forall (m :: * -> *). Monad m => m String -> Cmd m ()
lim80 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadLB m => String -> m String
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  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Pretty a => a -> String
Hs.prettyPrint SrcLoc
l forall a. [a] -> [a] -> [a]
++ Char
':' forall a. a -> [a] -> [a]
: String
e)
        Hs.ParseOk{}        -> String -> String
postProcess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *). MonadLB m => String -> m String
runGHC (String
"text (myquickcheck (" forall a. [a] -> [a] -> [a]
++ String
src forall a. [a] -> [a] -> [a]
++ String
"))")

postProcess :: String -> String
postProcess String
xs =
    let ([String]
first, [String]
rest) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 (forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) (String -> [String]
lines String
xs))
    in  [String] -> String
unlines ([String]
first forall a. [a] -> [a] -> [a]
++ [[String] -> String
unwords [String]
rest | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
rest)])