diff --git a/Readme b/Readme --- a/Readme +++ b/Readme @@ -14,14 +14,14 @@ =================== Leksah currently requires: - GHC version 6.10.x-6.12 - gtk2hs 0.10.x- - other dependencies see cabal file + GHC + gtk2hs + For more details see the leksah.cabal file If you are a user or just test Leksah, we would appreciate to here from you. Please send questions and suggestions to the developers -info(at)leksah(dot)org +info(at)leksah(dot)org diff --git a/data/prefscoll.lkshp b/data/prefscoll.lkshp --- a/data/prefscoll.lkshp +++ b/data/prefscoll.lkshp @@ -1,12 +1,12 @@ Paths under which haskell sources for packages may be found: [] -Unpack source for cabal packages to: +Maybe a directory for unpacking cabal packages: Just "~/.leksah-0.12/packageSources" -URL from which to download prebuilt metadata: +An URL to load prebuild metadata: "http://www.leksah.org" -Strategy for downloading prebuilt metadata: +A strategy for downloading prebuild metadata: RetrieveThenBuild -Port number for leksah to comunicate with leksah-server: +Port number for server connection: 11111 -Stop the leksah-server process when leksah disconnects: +End the server with last connection: True diff --git a/leksah.cabal b/leksah.cabal --- a/leksah.cabal +++ b/leksah.cabal @@ -1,6 +1,6 @@ name: leksah -version: 0.12.0.3 -cabal-version: >=1.8 +version: 0.12.1.0 +cabal-version: >=1.10 build-type: Simple license: GPL license-file: LICENSE @@ -111,18 +111,18 @@ ghc-options: -threaded hs-source-dirs: src - extensions: CPP + default-language: Haskell98 build-depends: Cabal >=1.6.0.1 && <1.15, base >=4.0.0.0 && <4.6, binary >=0.5.0.0 && <0.6, bytestring >=0.9.0.1 && <0.10, containers >=0.2.0.0 && <0.5, directory >=1.0.0.2 && <3.1, filepath >=1.1.0.1 && <1.4, glib >=0.10 && <0.13, gtk >=0.10 && <0.13, - gtksourceview2 >=0.10.0 && <0.13, mtl >=1.1.0.2 && <2.1, old-time >=1.0.0.1 && <1.2, + gtksourceview2 >=0.10.0 && <0.13, mtl >=1.1.0.2 && <2.2, old-time >=1.0.0.1 && <1.2, parsec >=2.1.0.1 && <3.2, pretty >=1.0.1.0 && <1.2, regex-tdfa ==1.1.*, regex-base ==0.93.*, utf8-string >=0.3.1.1 && <0.4, array >=0.2.0.0 && <0.5, - time >=0.1 && <1.5, ltk >= 0.12 && <0.13, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4, - hslogger >= 1.0.7 && <1.2, leksah-server >=0.12.0.3 && <0.13, network >= 2.2 && <3.0, + time >=0.1 && <1.5, ltk >= 0.12.1.0 && <0.13, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4, + hslogger >= 1.0.7 && <1.2, leksah-server >=0.12.1.0 && <0.13, network >= 2.2 && <3.0, ghc >=6.10.1 && <7.5, strict >= 0.3.2 && <0.4, enumerator >=0.4.14 && <0.5, text >= 0.11.1.5 && < 0.12, - gio >=0.12.2 && <0.13, transformers >=0.2.2.0 && <0.3, + gio >=0.12.2 && <0.13, transformers >=0.2.2.0 && <0.4, QuickCheck >=2.4.2 && <2.5 exposed-modules: @@ -187,24 +187,32 @@ build-depends: Cabal >=1.6.0.1 && <1.15, base >=4.0.0.0 && <4.6, binary >=0.5.0.0 && <0.6, bytestring >=0.9.0.1 && <0.10, containers >=0.2.0.0 && <0.5, directory >=1.0.0.2 && <3.1, filepath >=1.1.0.1 && <1.4, glib >=0.10 && <0.13, gtk >=0.10 && <0.13, - gtksourceview2 >=0.10.0 && <0.13, mtl >=1.1.0.2 && <2.1, old-time >=1.0.0.1 && <1.2, + gtksourceview2 >=0.10.0 && <0.13, mtl >=1.1.0.2 && <2.2, old-time >=1.0.0.1 && <1.2, parsec >=2.1.0.1 && <3.2, pretty >=1.0.1.0 && <1.2, regex-tdfa ==1.1.*, regex-base ==0.93.*, utf8-string >=0.3.1.1 && <0.4, array >=0.2.0.0 && <0.5, - time >=0.1 && <1.5, ltk >=0.12 && <0.13, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4, - hslogger >= 1.0.7 && <1.2, leksah-server >=0.12.0.3 && <0.13, network >= 2.2 && <3.0, + time >=0.1 && <1.5, ltk >=0.12.1.0 && <0.13, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4, + hslogger >= 1.0.7 && <1.2, leksah-server >=0.12.1.0 && <0.13, network >= 2.2 && <3.0, ghc >=6.10.1 && <7.5, strict >= 0.3.2 && <0.4, enumerator >=0.4.14 && <0.5, text >= 0.11.1.5 && < 0.12, - gio >=0.12.2 && <0.13, transformers >=0.2.2.0 && <0.3, + gio >=0.12.2 && <0.13, transformers >=0.2.2.0 && <0.4, QuickCheck >=2.4.2 && <2.5 else hs-source-dirs: main - build-depends: leksah ==0.12.0.3, base >=4.0.0.0 && <= 5 + build-depends: leksah ==0.12.1.0, base >=4.0.0.0 && <= 5 + default-language: Haskell98 main-is: Main.hs buildable: True - extensions: CPP ghc-prof-options: -auto-all -prof ghc-shared-options: -auto-all ghc-options: -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans + +test-suite tests + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Tests.hs + build-depends: base >= 4.0.0.0 && <4.6, Cabal >=1.6.0.1 && <1.15, QuickCheck >=2.4.2 && <2.5, + leksah ==0.12.1.0 diff --git a/src/IDE/Core/State.hs b/src/IDE/Core/State.hs --- a/src/IDE/Core/State.hs +++ b/src/IDE/Core/State.hs @@ -175,10 +175,11 @@ (case mbAP of Nothing -> Nothing Just (pn,_) -> Just pn) - modifyIDE_ (\ide -> ide{recentPanes = - paneName pane : filter (/= paneName pane) (recentPanes ide)}) + modifyIDE_ updateRecent return () where + updateRecent (ide@IDE{currentState = IsFlipping _}) = ide + updateRecent ide = ide{recentPanes = paneName pane : filter (/= paneName pane) (recentPanes ide)} trigger :: Maybe String -> Maybe String -> IDEAction trigger s1 s2 = do triggerEventIDE (RecordHistory ((PaneSelected s1), PaneSelected s2)) diff --git a/src/IDE/Core/Types.hs b/src/IDE/Core/Types.hs --- a/src/IDE/Core/Types.hs +++ b/src/IDE/Core/Types.hs @@ -1,13 +1,14 @@ -{-# OPTIONS_GHC - -XDisambiguateRecordFields - -XExistentialQuantification - -XRank2Types - -XFlexibleInstances - -XDeriveDataTypeable - -XFlexibleContexts - -XDeriveDataTypeable - -XTypeSynonymInstances - -XMultiParamTypeClasses #-} +{-# LANGUAGE + CPP + , DisambiguateRecordFields + , ExistentialQuantification + , Rank2Types + , FlexibleInstances + , DeriveDataTypeable + , FlexibleContexts + , DeriveDataTypeable + , TypeSynonymInstances + , MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- diff --git a/src/IDE/ImportTool.hs b/src/IDE/ImportTool.hs --- a/src/IDE/ImportTool.hs +++ b/src/IDE/ImportTool.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- -- Module : IDE.ImportTool @@ -18,7 +19,8 @@ , addImport , addPackage , parseNotInScope -, parseHiddenModule +, parseHiddenModule +, HiddenModuleResult(..) ) where import IDE.Core.State @@ -53,7 +55,9 @@ import Distribution.Verbosity (normal) import IDE.Pane.PackageEditor (hasConfigs) import Distribution.Package -import Distribution.Version (anyVersion) +import Distribution.Version + (anyVersion, orLaterVersion, intersectVersionRanges, + earlierVersion, Version(..)) import Distribution.PackageDescription (CondTree(..), condExecutables, condLibrary, packageDescription, buildDepends) @@ -149,8 +153,8 @@ ideMessage Normal $ "addPackage " ++ (display $ pkgName pack) #if MIN_VERSION_Cabal(1,10,0) liftIO $ writeGenericPackageDescription (ipdCabalFile $ idePackage) - gpd { condLibrary = addDepToLib (packageName pack) (condLibrary gpd), - condExecutables = map (addDepToExe (packageName pack)) + gpd { condLibrary = addDepToLib pack (condLibrary gpd), + condExecutables = map (addDepToExe pack) (condExecutables gpd)} return True #else @@ -159,17 +163,26 @@ else do let flat = flattenPackageDescription gpd liftIO $ writePackageDescription (ipdCabalFile $ idePackage) - flat { buildDepends = - Dependency (pkgName pack) anyVersion : buildDepends flat} + flat { buildDepends = dep pack : buildDepends flat} return True #endif where - addDepToLib n Nothing = Nothing - addDepToLib n (Just cn@CondNode{condTreeConstraints = deps}) = - Just (cn{condTreeConstraints = (Dependency n anyVersion) : deps}) - addDepToExe n (str,cn@CondNode{condTreeConstraints = deps}) = - (str,cn{condTreeConstraints = (Dependency n anyVersion) : deps}) - + addDepToLib _ Nothing = Nothing + addDepToLib p (Just cn@CondNode{condTreeConstraints = deps}) = + Just (cn{condTreeConstraints = dep p : deps}) + addDepToExe p (str,cn@CondNode{condTreeConstraints = deps}) = + (str,cn{condTreeConstraints = dep p : deps}) + -- Empty version is probably only going to happen for ghc-prim + dep p | null . versionBranch $ packageVersion p = Dependency (packageName p) (anyVersion) + dep p = Dependency (packageName p) ( + intersectVersionRanges (orLaterVersion (packageVersion p)) + (earlierVersion (majorAndMinor (packageVersion p)))) + + majorAndMinor v@Version{versionBranch = b} = v{versionBranch = nextMinor b} + nextMinor = nextMinor' . (++[0,0]) + nextMinor' (major:minor:_) = [major, minor+1] + nextMinor' _ = undefined + getScopeForActiveBuffer :: IDEM (Maybe (GenScope, GenScope)) getScopeForActiveBuffer = do mbActiveBuf <- maybeActiveBuf @@ -226,7 +239,7 @@ fileSave False setModified gtkbuf True continuation (True,(descr : descrList)) - ServerFailed string -> do + ServerFailed string -> do ideMessage Normal ("Can't parse module header " ++ filePath ++ " failed with: " ++ string) continuation (False,[]) @@ -389,13 +402,6 @@ Just pm -> (render . disp . modu) pm == v) list))) _ -> return Nothing ---testString = " Could not find module `Graphics.UI.Gtk':\n" --- ++ " It is a member of the hidden package `gtk-0.11.0'.\n" --- ++ " Perhaps you need to add `gtk' to the build-depends in your .cabal file.\n" --- ++ " Use -v to see a list of the files searched for." --- ---test = parseHiddenModule testString == Just (HiddenModuleResult {hiddenModule = "Graphics.UI.Gtk", missingPackage = PackageIdentifier {pkgName = PackageName "gtk", pkgVersion = Version {versionBranch = [0,11,0], versionTags = []}}}) - data HiddenModuleResult = HiddenModuleResult { hiddenModule :: String , missingPackage :: PackageId} @@ -414,8 +420,9 @@ hiddenModuleParser = do whiteSpace symbol "Could not find module `" - mod <- many (noneOf "'") - symbol "':\n" + mod <- many (noneOf "'") + many (noneOf "\n") + symbol "\n" whiteSpace symbol "It is a member of the hidden package `" pack <- many (noneOf "'") diff --git a/src/IDE/NotebookFlipper.hs b/src/IDE/NotebookFlipper.hs --- a/src/IDE/NotebookFlipper.hs +++ b/src/IDE/NotebookFlipper.hs @@ -18,21 +18,26 @@ ) where import Graphics.UI.Gtk - (treeViewSetCursor, treeViewGetCursor, treeModelIterNChildren, + (treeSelectionGetSelectedRows, + treeSelectionSelectionChanged, treeViewGetSelection, rowActivated, + treeViewSetCursor, treeViewGetCursor, treeModelIterNChildren, treeViewGetModel, treeViewRowActivated, treeViewGetColumn, widgetShowAll, windowWindowPosition, widgetDestroy, widgetHideAll, - listStoreGetValue, onRowActivated, onKeyRelease, + listStoreGetValue, keyReleaseEvent, treeViewHeadersVisible, cellText, cellLayoutSetAttributes, treeViewColumnPackStart, cellRendererTextNew, treeViewAppendColumn, treeViewColumnNew, treeViewSetModel, listStoreNew, treeViewNew, - containerAdd, frameNew, windowResizable, windowSetTransientFor, - windowNewPopup, TreeViewClass, WindowPosition(..), signalDisconnect, - AttrOp(..), set) -import IDE.Core.State -import Graphics.UI.Gtk.Gdk.Events (Event(..)) + containerAdd, windowResizable, windowSetTransientFor, + windowNewPopup, TreeViewClass, WindowPosition(..), + signalDisconnect, AttrOp(..), set, EventM, EKey, eventKeyName, + windowGetSize, windowTypeHint, WindowTypeHint(..), windowDecorated, + windowDefaultWidth, windowDefaultHeight, scrolledWindowNew) +import IDE.Core.State hiding (window, name) import Control.Monad (when) import IDE.Pane.SourceBuffer(recentSourceBuffers) import Control.Monad.IO.Class (MonadIO(..)) +import System.Glib.Signals (on) +import qualified Control.Monad.Reader as Gtk (liftIO) flipDown :: IDEAction flipDown = do @@ -89,19 +94,27 @@ initFlipper direction = do mainWindow <- getMainWindow recentPanes' <- recentSourceBuffers - tree' <- reifyIDE $ \ideR -> do + (tree', store') <- reifyIDE $ \ideR -> do window <- windowNewPopup windowSetTransientFor window mainWindow - set window [windowResizable := True] - frame <- frameNew - containerAdd window frame + (_, height) <- windowGetSize mainWindow + set window [ + windowTypeHint := WindowTypeHintUtility, + windowDecorated := False, + windowResizable := True, + windowDefaultWidth := 200, + windowDefaultHeight := height] + + scrolledWindow <- scrolledWindowNew Nothing Nothing + containerAdd window scrolledWindow + tree <- treeViewNew + containerAdd scrolledWindow tree - containerAdd frame tree store <- listStoreNew recentPanes' treeViewSetModel tree store column <- treeViewColumnNew - treeViewAppendColumn tree column + _ <- treeViewAppendColumn tree column renderer <- cellRendererTextNew treeViewColumnPackStart column renderer True cellLayoutSetAttributes column renderer store @@ -109,41 +122,61 @@ set tree [treeViewHeadersVisible := False] - cid <- onKeyRelease mainWindow $ handleKeyRelease tree ideR + cid <- mainWindow `on` keyReleaseEvent $ handleKeyRelease tree ideR - onRowActivated tree (\treePath column -> do + _ <- tree `on` rowActivated $ \treePath _column -> do signalDisconnect cid let [row] = treePath string <- listStoreGetValue store row reflectIDE (do mbPane <- mbPaneFromName string case mbPane of - Just (PaneC pane) -> makeActive pane + Just (PaneC pane) -> do + makeActive pane + modifyIDE_ $ \ide -> ide{ + recentPanes = paneName pane : filter (/= paneName pane) (recentPanes ide)} Nothing -> return ()) ideR widgetHideAll window - widgetDestroy window) + widgetDestroy window + reflectIDE (modifyIDE_ (\ide -> ide{currentState = IsRunning})) ideR + + treeSelection <- treeViewGetSelection tree + _ <- treeSelection `on` treeSelectionSelectionChanged $ do + rows <- treeSelectionGetSelectedRows treeSelection + case rows of + [[row]] -> do + string <- listStoreGetValue store row + reflectIDE (do + mbPane <- mbPaneFromName string + case mbPane of + Just (PaneC pane) -> makeActive pane + Nothing -> return ()) ideR + _ -> return () + set window [windowWindowPosition := WinPosCenterOnParent] - n <- treeModelIterNChildren store Nothing - treeViewSetCursor tree [if direction then min 1 (n-1) else (n-1)] Nothing widgetShowAll window - return tree + return (tree, store) modifyIDE_ (\ide -> ide{currentState = IsFlipping tree'}) + liftIO $ do + -- This is done after currentState is set so we know not to update the + -- previous panes list + n <- treeModelIterNChildren store' Nothing + treeViewSetCursor tree' [if direction then min 1 (n-1) else (n-1)] Nothing return () -handleKeyRelease :: TreeViewClass alpha => alpha -> IDERef -> Event -> IO (Bool) -handleKeyRelease tree ideR Key{eventKeyName = name, eventModifier = modifier, eventKeyChar = char} = do - case (name, modifier, char) of - (ctrl, _, _) | (ctrl == "Control_L") || (ctrl == "Control_R") -> do +handleKeyRelease :: TreeViewClass alpha => alpha -> IDERef -> EventM EKey Bool +handleKeyRelease tree ideR = do + name <- eventKeyName + Gtk.liftIO $ case name of + ctrl | (ctrl == "Control_L") || (ctrl == "Control_R") -> do currentState' <- reflectIDE (readIDE currentState) ideR case currentState' of - IsFlipping tv -> do + IsFlipping _tv -> do (treePath, _) <- treeViewGetCursor tree Just column <- treeViewGetColumn tree 0 treeViewRowActivated tree treePath column - reflectIDE (modifyIDE_ (\ide -> ide{currentState = IsRunning})) ideR return False _ -> return False - (_,_,_) -> return False -handleKeyRelease tree ideR _ = return False + _ -> return False diff --git a/src/IDE/OSX.hs b/src/IDE/OSX.hs --- a/src/IDE/OSX.hs +++ b/src/IDE/OSX.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- -- Module : IDE.OSX diff --git a/src/IDE/Package.hs b/src/IDE/Package.hs --- a/src/IDE/Package.hs +++ b/src/IDE/Package.hs @@ -302,6 +302,7 @@ lift $ catchIDE (do let dir = dropFileName (ipdCabalFile package) runExternalTool "Installing" "cabal" (["install","--only-dependencies"] + ++ (ipdConfigFlags package) ++ (ipdInstallFlags package)) (Just dir) logOutput) (\(e :: SomeException) -> putStrLn (show e)) @@ -396,7 +397,6 @@ let path = dropFileName (ipdCabalFile package) "dist/doc/html" display (pkgName (ipdPackageId package)) - display (pkgName (ipdPackageId package)) "index.html" dir = dropFileName (ipdCabalFile package) runExternalTool "Opening Documentation" (browser prefs) [path] (Just dir) logOutput) @@ -404,16 +404,16 @@ runExternalTool :: String -> FilePath -> [String] -> Maybe FilePath -> E.Iteratee ToolOutput IDEM () -> IDEAction runExternalTool description executable args mbDir handleOutput = do - prefs <- readIDE prefs - alreadyRunning <- isRunning - unless alreadyRunning $ do - when (saveAllBeforeBuild prefs) (do fileSaveAll belongsToWorkspace; return ()) - triggerEventIDE (StatusbarChanged [CompartmentState description, CompartmentBuild True]) - reifyIDE $ \ideR -> forkIO $ do - (output, pid) <- runTool executable args mbDir - reflectIDE (modifyIDE_ (\ide -> ide{runningTool = Just pid})) ideR - E.run_ $ output $$ (reflectIDEI handleOutput ideR) - return () + prefs <- readIDE prefs + alreadyRunning <- isRunning + unless alreadyRunning $ do + when (saveAllBeforeBuild prefs) (do fileSaveAll belongsToWorkspace; return ()) + triggerEventIDE (StatusbarChanged [CompartmentState description, CompartmentBuild True]) + reifyIDE $ \ideR -> forkIO $ do + (output, pid) <- runTool executable args mbDir + reflectIDE (modifyIDE_ (\ide -> ide{runningTool = Just pid})) ideR + E.run_ $ output $$ (reflectIDEI handleOutput ideR) + return () -- --------------------------------------------------------------------- diff --git a/src/IDE/Pane/Info.hs b/src/IDE/Pane/Info.hs --- a/src/IDE/Pane/Info.hs +++ b/src/IDE/Pane/Info.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses, - ScopedTypeVariables, TypeSynonymInstances #-} + CPP, ScopedTypeVariables, TypeSynonymInstances #-} {-# OPTIONS_GHC -fwarn-unused-imports #-} ----------------------------------------------------------------------------- -- diff --git a/src/IDE/Pane/Log.hs b/src/IDE/Pane/Log.hs --- a/src/IDE/Pane/Log.hs +++ b/src/IDE/Pane/Log.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, +{-# LANGUAGE CPP, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances, ParallelListComp #-} -- -- Module : IDE.Pane.Log diff --git a/src/IDE/Pane/PackageEditor.hs b/src/IDE/Pane/PackageEditor.hs --- a/src/IDE/Pane/PackageEditor.hs +++ b/src/IDE/Pane/PackageEditor.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable, - MultiParamTypeClasses, TypeSynonymInstances #-} + CPP, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.PackageEditor diff --git a/src/IDE/Pane/SourceBuffer.hs b/src/IDE/Pane/SourceBuffer.hs --- a/src/IDE/Pane/SourceBuffer.hs +++ b/src/IDE/Pane/SourceBuffer.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses, - TypeSynonymInstances, ScopedTypeVariables, RankNTypes #-} + CPP, TypeSynonymInstances, ScopedTypeVariables, RankNTypes #-} {-# OPTIONS_GHC -fwarn-unused-imports #-} ----------------------------------------------------------------------------- -- diff --git a/src/IDE/TextEditor.hs b/src/IDE/TextEditor.hs --- a/src/IDE/TextEditor.hs +++ b/src/IDE/TextEditor.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- -- Module : IDE.TextEditor diff --git a/src/IDE/Utils/GUIUtils.hs b/src/IDE/Utils/GUIUtils.hs --- a/src/IDE/Utils/GUIUtils.hs +++ b/src/IDE/Utils/GUIUtils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Utils.GUIUtils diff --git a/src/IDE/Utils/ServerConnection.hs b/src/IDE/Utils/ServerConnection.hs --- a/src/IDE/Utils/ServerConnection.hs +++ b/src/IDE/Utils/ServerConnection.hs @@ -58,15 +58,15 @@ return () where doCommand handle = do - triggerEventIDE (StatusbarChanged [CompartmentCollect True]) - reifyIDE $ \ideR -> forkIO $ do - hPutStrLn handle (show command) - hFlush handle - resp <- hGetLine handle - postGUIAsync (reflectIDE (do - triggerEvent ideR (StatusbarChanged [CompartmentCollect False]) - cont (read resp) - return ()) ideR) + triggerEventIDE (StatusbarChanged [CompartmentCollect True]) + reifyIDE $ \ideR -> forkIO $ do + hPutStrLn handle (show command) + hFlush handle + resp <- hGetLine handle + postGUIAsync (reflectIDE (do + triggerEvent ideR (StatusbarChanged [CompartmentCollect False]) + cont (read resp) + return ()) ideR) startServer :: Int -> IO () startServer port = do diff --git a/src/IDE/YiConfig.hs b/src/IDE/YiConfig.hs --- a/src/IDE/YiConfig.hs +++ b/src/IDE/YiConfig.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {- Based on example config Yi/Users/Corey.hs that uses the Vim keymap with these additions: - Always uses the VTY UI by default. - The color style is darkBlueTheme diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE TemplateHaskell #-} +----------------------------------------------------------------------------- +-- +-- Module : Tests +-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie +-- License : GNU-GPL +-- +-- Maintainer : +-- Stability : provisional +-- Portability : portable +-- +-- | +-- +------------------------------------------------------------------------------- +module Main (main) where + +import System.Exit (exitFailure) +import Test.QuickCheck.All (quickCheckAll) +import IDE.ImportTool (parseHiddenModule, HiddenModuleResult(..)) +import Control.Monad (unless) +import Distribution.Package + (PackageName(..), PackageIdentifier(..)) +import Distribution.Version (Version(..)) + +testString = " Could not find module `Graphics.UI.Gtk':\n" + ++ " It is a member of the hidden package `gtk-0.11.0'.\n" + ++ " Perhaps you need to add `gtk' to the build-depends in your .cabal file.\n" + ++ " Use -v to see a list of the files searched for." + +prop_parseHiddenModule = parseHiddenModule testString == Just (HiddenModuleResult {hiddenModule = "Graphics.UI.Gtk", missingPackage = PackageIdentifier {pkgName = PackageName "gtk", pkgVersion = Version {versionBranch = [0,11,0], versionTags = []}}}) + +-- At some point the : was removed from this message... +testString2 = " Could not find module `Data.Attoparsec.Lazy'\n" + ++ " It is a member of the hidden package `attoparsec-0.10.2.0'.\n" + ++ " Perhaps you need to add `attoparsec' to the build-depends in your .cabal file.\n" + ++ " Use -v to see a list of the files searched for.\n" + +prop_parseHiddenModule2 = parseHiddenModule testString2 == Just (HiddenModuleResult {hiddenModule = "Data.Attoparsec.Lazy", missingPackage = PackageIdentifier {pkgName = PackageName "attoparsec", pkgVersion = Version {versionBranch = [0,10,2,0], versionTags = []}}}) + +main = do + allPass <- $quickCheckAll -- Run QuickCheck on all prop_ functions + unless allPass exitFailure