hpage 0.4 → 0.4.1
raw patch · 10 files changed
+83/−52 lines, 10 filesdep −MissingH
Dependencies removed: MissingH
Files
- hpage.cabal +3/−10
- res/test/FlexibleInstances.hs +4/−0
- res/test/OverlappingInstances.hs +13/−0
- res/test/TypeSynonymInstances.hs +5/−0
- src/HPage/Control.hs +40/−8
- src/HPage/GUI/FreeTextWindow.hs +2/−2
- src/HPage/Test/Extensions/FlexibleInstances.hs +0/−4
- src/HPage/Test/Extensions/OverlappingInstances.hs +0/−13
- src/HPage/Test/Extensions/TypeSynonymInstances.hs +0/−5
- src/HPage/Test/Server.hs +16/−10
hpage.cabal view
@@ -1,5 +1,5 @@ name: hpage-version: 0.4+version: 0.4.1 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -20,6 +20,7 @@ res/images/icon/hPage.icns res/images/icon/hpage.tif res/help/helpPage.hs+ res/test/*.hs data-dir: "" extra-source-files: Setup.hs extra-tmp-files:@@ -41,25 +42,17 @@ wx >=0.11.1, wx < 0.12, filepath >=1.1.0, filepath < 1.2, Cabal >= 1.6, Cabal < 1.7,- MissingH >= 1.1, MissingH < 1.2, hint >=0.3.1, hint < 0.4, eprocess >= 1.0.0, eprocess < 2, hint-server >= 1.0.0, hint-server < 2 main-is: Main.hs buildable: True- extensions: CPP hs-source-dirs: src- other-modules: - HPage.GUI.IDs,+ other-modules: HPage.GUI.IDs, HPage.GUI.FreeTextWindow, HPage.GUI.Dialogs, HPage.Control, HPage.Server, HPage.Test.Server,- HPage.Test.Extensions.FlexibleInstances,- HPage.Test.Extensions.OverlappingInstances,- HPage.Test.Extensions.TypeSynonymInstances, HPage.Utils.Log- ghc-prof-options: -auto-all -prof- ghc-shared-options: -auto-all -prof ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns
+ res/test/FlexibleInstances.hs view
@@ -0,0 +1,4 @@++instance Functor (Either Int) where + fmap _ (Left n) = Left n + fmap f (Right r) = Right (f r)
+ res/test/OverlappingInstances.hs view
@@ -0,0 +1,13 @@+import Data.List ++class Foo a where + foo :: a -> String ++instance Foo a => Foo [a] where + foo = concat . intersperse ", " . map foo ++instance Foo Char where + foo c = [c] ++instance Foo String where + foo = id
+ res/test/TypeSynonymInstances.hs view
@@ -0,0 +1,5 @@+class ExtTest a where+ extes :: a -> String+ +instance ExtTest String where+ extes = show . map show
src/HPage/Control.hs view
@@ -40,7 +40,8 @@ getGhcOpts, setGhcOpts, loadPackage, valueOf', valueOfNth', kindOf', kindOfNth', typeOf', typeOfNth',- loadModules', reloadModules', getLoadedModules', importModules', getImportedModules',+ loadModules', + reloadModules', getLoadedModules', importModules', getImportedModules', getModuleExports', getLanguageExtensions', setLanguageExtensions', getSourceDirs', setSourceDirs',@@ -49,7 +50,7 @@ cancel, Hint.InterpreterError, prettyPrintError, Hint.availableExtensions, Hint.Extension(..),- ModuleElemDesc(..),+ ModuleDescription(..), ModuleElemDesc(..), -- DEBUG -- ctxString ) where@@ -70,7 +71,6 @@ import qualified Language.Haskell.Interpreter.Server as HS import HPage.Utils.Log import Data.List (isPrefixOf)-import Data.List.Utils import qualified Data.List as List import qualified Data.ByteString.Char8 as Str import qualified Language.Haskell.Exts.Parser as Parser@@ -81,6 +81,13 @@ import Distribution.ModuleName import Distribution.Compiler +data ModuleDescription = ModDesc {modName :: String,+ modInterpreted :: Bool}+ deriving (Eq)++instance Show ModuleDescription where+ show m = show (modName m, modInterpreted m)+ data ModuleElemDesc = MEFun {funName :: String, funType :: String} | MEClass {clsName :: String,@@ -454,8 +461,13 @@ Hint.loadModules ms Hint.getLoadedModules >>= Hint.setTopLevelModules -getLoadedModules :: HPage (Either Hint.InterpreterError [Hint.ModuleName])-getLoadedModules = confirmRunning >> syncRun Hint.getLoadedModules+getLoadedModules :: HPage (Either Hint.InterpreterError [ModuleDescription])+getLoadedModules = do+ confirmRunning+ syncRun $ do+ mns <- Hint.getLoadedModules+ mis <- mapM Hint.isModuleInterpreted mns+ return $ zipWith ModDesc mns mis getImportedModules :: HPage [Hint.ModuleName] getImportedModules = confirmRunning >>= return . toList . importedModules @@ -605,9 +617,14 @@ Hint.loadModules ms Hint.getLoadedModules >>= Hint.setTopLevelModules -getLoadedModules' :: HPage (MVar (Either Hint.InterpreterError [Hint.ModuleName]))-getLoadedModules' = confirmRunning >> asyncRun Hint.getLoadedModules-+getLoadedModules' :: HPage (MVar (Either Hint.InterpreterError [ModuleDescription]))+getLoadedModules' = do+ confirmRunning+ asyncRun $ do+ mns <- Hint.getLoadedModules+ mis <- mapM Hint.isModuleInterpreted mns+ return $ zipWith ModDesc mns mis+ getImportedModules' :: HPage (MVar [Hint.ModuleName]) getImportedModules' = confirmRunning >>= liftIO . newMVar . toList . importedModules @@ -848,3 +865,18 @@ moduleElemDesc (Hint.Data dn dcs) = do mdcs <- flip mapM dcs $ moduleElemDesc . Hint.Fun return MEData{datName = dn, datCtors = mdcs}+ +{- | Given a list, returns a new list with all duplicate elements removed.+For example:++>uniq "Mississippi" -> "Misp"++You should not rely on this function necessarily preserving order, though+the current implementation happens to.++This function is not compatible with infinite lists.++TAKEN FROM: http://hackage.haskell.org/packages/archive/MissingH/1.0.0/doc/html/src/Data-List-Utils.html#uniq -}+uniq :: Eq a => [a] -> [a]+uniq [] = []+uniq (x:xs) = x : uniq (filter (/= x) xs)
src/HPage/GUI/FreeTextWindow.hs view
@@ -584,7 +584,7 @@ --NOTE: we know 0 == "imported" / 1 == "interpreted" / 2 == "compiled" images --TODO: move that to some kind of constants or so let ims' = map (\m -> (0, m)) ims- ms' = map (\m -> (1, m)) ms --TODO: Verify if it is intrepreted+ ms' = map (\m -> (if HP.modInterpreted m then 1 else 2, HP.modName m)) ms allms = zip [0..] (ims' ++ ms') itemsDelete lstLoadedModules (flip mapM) allms $ \(idx, (img, m)) ->@@ -592,7 +592,7 @@ set lstLoadedModules [item idx := [m]] itemsDelete lstPkgModules- (flip mapM) pms $ \pm -> itemAppend lstPkgModules (if pm `elem` ms then ('*':pm) else pm)+ (flip mapM) pms $ \pm -> itemAppend lstPkgModules (if any (\xm -> HP.modName xm == pm) ms then ('*':pm) else pm) -- Refresh the current text set txtCode [text := t]
− src/HPage/Test/Extensions/FlexibleInstances.hs
@@ -1,4 +0,0 @@--instance Functor (Either Int) where - fmap _ (Left n) = Left n - fmap f (Right r) = Right (f r)
− src/HPage/Test/Extensions/OverlappingInstances.hs
@@ -1,13 +0,0 @@-import Data.List --class Foo a where - foo :: a -> String --instance Foo a => Foo [a] where - foo = concat . intersperse ", " . map foo --instance Foo Char where - foo c = [c] --instance Foo String where - foo = id
− src/HPage/Test/Extensions/TypeSynonymInstances.hs
@@ -1,5 +0,0 @@-class ExtTest a where- extes :: a -> String- -instance ExtTest String where- extes = show . map show
src/HPage/Test/Server.hs view
@@ -13,7 +13,7 @@ import Control.Monad.Loops import qualified Data.ByteString.Char8 as Str import HPage.Utils.Log--- import Data.Set (fromList)+import Paths_hpage instance Arbitrary Char where arbitrary = elements (['A'..'Z'] ++ ['a' .. 'z'])@@ -61,14 +61,14 @@ coarbitrary _ = undefined wexTypeSynonymInstances :: WorkingExtension-wexTypeSynonymInstances = WEX [HP.TypeSynonymInstances] "HPage/Test/Extensions/TypeSynonymInstances.hs"+wexTypeSynonymInstances = WEX [HP.TypeSynonymInstances] "TypeSynonymInstances.hs" wexOverlappingInstances :: WorkingExtension wexOverlappingInstances = WEX [HP.TypeSynonymInstances,- HP.OverlappingInstances] "HPage/Test/Extensions/OverlappingInstances.hs"+ HP.OverlappingInstances] "OverlappingInstances.hs" wexFlexibleInstances :: WorkingExtension-wexFlexibleInstances = WEX [HP.FlexibleInstances] "HPage/Test/Extensions/FlexibleInstances.hs"+wexFlexibleInstances = WEX [HP.FlexibleInstances] "FlexibleInstances.hs" shouldFail :: (MonadError e m) => m a -> m Bool shouldFail a = (a >> return False) `catchError` (\_ -> return True)@@ -244,12 +244,12 @@ HP.loadModules [testDir ++ "/test.hs"] HP.setPageText "v" 0 fv <- HP.valueOf- fm <- HP.getLoadedModules+ fm <- HP.getLoadedModules >>= return . mN -- Load TestFiles/Test...hs by name HP.loadModules [mname] HP.setPageText "v" 0 sv <- HP.valueOf- sm <- HP.getLoadedModules+ sm <- HP.getLoadedModules >>= return . mN return (fv, sv, fm, sm) hsr <- HS.runIn hs $ do Hint.loadModules [testDir ++ "/test.hs"]@@ -263,6 +263,9 @@ return (Right fv, Right sv, Right fm, Right sm) -- liftDebugIO (hpsr, hsr) return $ Right hpsr == hsr+ where mN (Right mns) = Right $ map HP.modName mns+ mN (Left err) = Left err+ prop_reload_modules :: HPS.ServerHandle -> HS.ServerHandle -> String -> Bool prop_reload_modules hps hs txt =@@ -304,8 +307,10 @@ hpsr3 <- HPS.runIn hps $ HP.loadModules [mnf3] >> HP.getLoadedModules hsr3 <- HS.runIn hs $ Hint.loadModules [mnf3] >> Hint.getLoadedModules --liftDebugIO [(hpsr1, hpsr2, hpsr3), (hsr1, hsr2, hsr3)]- return $ (hpsr1, hpsr2, hpsr3) == (hsr1, hsr2, hsr3)- + return $ (mN hpsr1, mN hpsr2, mN hpsr3) == (hsr1, hsr2, hsr3)+ where mN (Right mns) = Right $ map HP.modName mns+ mN (Left err) = Left err+ prop_sequential :: HPS.ServerHandle -> String -> Bool prop_sequential hps txt = unsafePerformIO $ do@@ -993,10 +998,11 @@ prop_working_extensions :: HPS.ServerHandle -> WorkingExtension -> Bool prop_working_extensions hps (WEX es m) = unsafePerformIO $ HPS.runIn hps $ do+ path <- Hint.liftIO . getDataFileName $ "res/test/" ++ m HP.setLanguageExtensions []- before <- HP.loadModules [m]+ before <- HP.loadModules [path] HP.setLanguageExtensions es- after <- HP.loadModules [m]+ after <- HP.loadModules [path] let failed = case before of Left _ -> True _ -> False