lambdabot-haskell-plugins 5.2 → 5.3

raw patch · 9 files changed

+31/−53 lines, 9 filesdep ~haskell-src-exts-simpledep ~lambdabot-coredep ~lambdabot-reference-pluginssetup-changed

Dependency ranges changed: haskell-src-exts-simple, lambdabot-core, lambdabot-reference-plugins, lambdabot-trusted

Files

• Setup.hs +1/−1
• lambdabot-haskell-plugins.cabal +8/−7
• src/Lambdabot/Plugin/Haskell/Check.hs +2/−1
• src/Lambdabot/Plugin/Haskell/Eval.hs +0/−31
• src/Lambdabot/Plugin/Haskell/Free/FreeTheorem.hs +3/−2
• src/Lambdabot/Plugin/Haskell/Free/Parse.hs +4/−0
• src/Lambdabot/Plugin/Haskell/Pl/Transform.hs +8/−6
• src/Lambdabot/Plugin/Haskell/Pointful.hs +1/−1
• src/Lambdabot/Plugin/Haskell/UnMtl.hs +4/−4

@@ -1,3 +1,3 @@ #!/usr/bin/env runhaskell import Distribution.Simple-main = defaultMainWithHooks defaultUserHooks+main = defaultMain

@@ -1,5 +1,5 @@ name:                   lambdabot-haskell-plugins-version:                5.2+version:                5.3  license:                GPL license-file:           LICENSE@@ -45,8 +45,8 @@ homepage:               https://wiki.haskell.org/Lambdabot  build-type:             Simple-cabal-version:          >= 1.8-tested-with:            GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5+cabal-version:          >= 1.10+tested-with:            GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3  extra-source-files:     src/Lambdabot/Plugin/Haskell/Free/Test.hs @@ -58,6 +58,7 @@   hs-source-dirs:       src   ghc-options:          -Wall                         -funbox-strict-fields+  default-language:     Haskell98    exposed-modules:      Lambdabot.Plugin.Haskell @@ -98,9 +99,9 @@                         containers              >= 0.4,                         directory               >= 1.1,                         filepath                >= 1.3,-                        haskell-src-exts-simple >= 1.18.0.0 && < 1.22,-                        lambdabot-core          >= 5.2 && < 5.3,-                        lambdabot-reference-plugins >= 5.2 && < 5.3,+                        haskell-src-exts-simple >= 1.18 && < 1.24,+                        lambdabot-core          >= 5.3 && < 5.4,+                        lambdabot-reference-plugins >= 5.3 && < 5.4,                         lifted-base             >= 0.2,                         mtl                     >= 2,                         oeis                    >= 0.3.1,@@ -119,7 +120,7 @@                         data-memocombinators    >= 0.4,                         hoogle                  >= 5.0.17.1,                         IOSpec                  >= 0.2,-                        lambdabot-trusted       >= 5.2 && < 5.3,+                        lambdabot-trusted       >= 5.3 && < 5.4,                         logict                  >= 0.5,                         MonadRandom             >= 0.1,                         mueval                  >= 0.9.3,

@@ -7,6 +7,7 @@ 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 = newModule@@ -22,7 +23,7 @@  check :: MonadLB m => String -> m String check src =-    case Hs.parseExp src of+    case Hs.parseExp (decodeString src) of         Hs.ParseFailed l e  -> return (Hs.prettyPrint l ++ ':' : e)         Hs.ParseOk{}        -> postProcess `fmap` runGHC ("text (myquickcheck (" ++ src ++ "))") 

@@ -21,8 +21,6 @@ import System.Exit import System.Process import Codec.Binary.UTF8.String-import Network.Browser (request)-import Network.HTTP (getRequest, rspBody)  evalPlugin :: Module () evalPlugin = newModule@@ -36,10 +34,6 @@             , help = say "let <x> = <e>. Add a binding"             , process = lim80 . define             }-        , (command "letlpaste")-            { help = say "letlpaste <paste_id>. Import the contents of an lpaste."-            , process = lim80 . defineFromLPaste-            }         , (command "undefine")             { help = say "undefine. Reset evaluator local bindings"             , process = \s ->@@ -180,31 +174,6 @@ munge, mungeEnc :: String -> String munge = expandTab 8 . strip (=='\n') mungeEnc = encodeString . munge----------------------------------- define from lpaste--defineFromLPaste :: MonadLB m => String -> m String-defineFromLPaste num = do-  maxlen <- getConfig maxPasteLength-  mcode <- fetchLPaste num-  case mcode of-    Left err   -> return err-    Right code-     | length code < maxlen -> define code-     | otherwise            -> return $-       "That paste is too long! (maximum length: " ++ show maxlen ++ ")"--fetchLPaste :: MonadLB m => String -> m (Either String String)-fetchLPaste num = browseLB $-  if any (`notElem` ['0'..'9']) num-    then return $ Left "Invalid paste ID."-    else do-      let src = "http://lpaste.net/raw/" ++ num-      (uri, resp) <- request $ getRequest src-      return $ if show uri == src-        then Right $ rspBody resp-        else Left "I couldn't find any paste under that ID."  ------------------------------ -- reset all bindings

@@ -9,6 +9,7 @@ import Lambdabot.Plugin.Haskell.Free.Util  import Control.Monad+import Control.Monad.Fail (MonadFail) import Control.Monad.State import Control.Monad.Identity @@ -48,7 +49,7 @@     = let ts12 = map (extractTypes env) ts       in (TyCons c (map fst ts12), TyCons c (map snd ts12)) -freeTheoremStr :: (Monad m) => (String -> m String) -> String -> m String+freeTheoremStr :: (MonadFail m) => (String -> m String) -> String -> m String freeTheoremStr tf s     = case parse (do                     v <- getToken >>= \v -> case v of@@ -292,6 +293,6 @@         return (foldr (\((f,t),e1) e2 -> ThForall f t (ThImplies e1 e2))                 thf fts) -freeTheorem' env e1 e2 t'@_ = fail "Sorry, this type is too difficult for me."+freeTheorem' env e1 e2 t'@_ = error "Sorry, this type is too difficult for me."  -- vim: ts=4:sts=4:expandtab:ai

@@ -4,6 +4,8 @@  import Control.Applicative import Control.Monad+import Control.Monad.Fail (MonadFail)+import qualified Control.Monad.Fail  data Token     = QVarId String@@ -75,6 +77,8 @@     m >>= k = ParseS (\ts -> case parse m ts of                                 ParseSuccess x ts' -> parse (k x) ts'                                 ParseError s       -> ParseError s)++instance MonadFail ParseS where     fail str = ParseS (\_ -> ParseError str)  instance Alternative ParseS where

@@ -55,7 +55,9 @@ unLet (Lambda v e) = Lambda v (unLet e) unLet (Var f x) = Var f x -type Env = M.Map String String+type Env = (M.Map String String, Int)+-- note: The second component is the environment size, counting duplicate+-- variables.  -- | Rename all variables to (locally) unique fresh ones --@@ -63,9 +65,9 @@ -- Otherwise a newly created id/const/... could be bound by a lambda -- e.g. transform' (\id x -> x) ==> transform' (\id -> id) ==> id alphaRename :: Expr -> Expr-alphaRename e = alpha e `evalState` M.empty where+alphaRename e = alpha e `evalState` (M.empty, 0) where   alpha :: Expr -> State Env Expr-  alpha (Var f v)     = do fm <- get; return $ Var f $ maybe v id (M.lookup v fm)+  alpha (Var f v)     = do (fm, _) <- get; return $ Var f $ maybe v id (M.lookup v fm)   alpha (App e1 e2)   = liftM2 App (alpha e1) (alpha e2)   alpha (Let _ _)     = assert False undefined   alpha (Lambda v e') = inEnv $ liftM2 Lambda (alphaPat v) (alpha e')@@ -75,9 +77,9 @@   inEnv f = state $ \s -> (fst $ runState f s, s)    alphaPat (PVar v) = do-    fm <- get-    let v' = "$" ++ show (M.size fm)-    put $ M.insert v v' fm+    (fm, i) <- get+    let v' = "$" ++ show i+    put (M.insert v v' fm, i+1)     return $ PVar v'   alphaPat (PTuple p1 p2) = liftM2 PTuple (alphaPat p1) (alphaPat p2)   alphaPat (PCons  p1 p2) = liftM2 PCons  (alphaPat p1) (alphaPat p2)

@@ -194,7 +194,7 @@     b -- replace (\x -> \y -> z) with (\x y -> z) optimizeE (Lambda p1 (Lambda p2 body)) =-    let (subst, bv, p2') = renameBinds M.empty (varsBoundHere p1) p2+    let (subst, bv, p2') = renameBinds M.empty (freeVars (Lambda p2 body)) p2         body' = substAvoiding subst bv body     in  Lambda (p1 ++ p2') body' -- remove double parens

@@ -164,17 +164,17 @@     hsMod <- liftE $ parseModule ("type X = " ++ input ++ "\n")     decls <- case hsMod of         (Hs.Module _ _ _ decls) -> return decls-        _ -> fail "Not a module?"+        _ -> Left "Not a module?"     hsType <- case decls of         (TypeDecl _ hsType:_) -> return hsType-        _ -> fail "No parse?"+        _ -> Left "No parse?"     let result = mtlParser' hsType     case pError result of-        Just e  -> fail e+        Just e  -> Left e         Nothing -> return (pResult result)   where     liftE (ParseOk a) = return a-    liftE (ParseFailed _src str) = fail str+    liftE (ParseFailed _src str) = Left str  mtlParser' :: Type -> PType mtlParser' t@(TyCon (UnQual (Ident v))) = case lookup v types of