leksah 0.13.4.3 → 0.14.0.0
raw patch · 66 files changed
+1797/−1501 lines, 66 filesdep +regex-tdfa-textdep ~QuickCheckdep ~conduitdep ~gio
Dependencies added: regex-tdfa-text
Dependency ranges changed: QuickCheck, conduit, gio, glib, gtk, gtk-mac-integration, gtk3, gtk3-mac-integration, gtksourceview2, gtksourceview3, haskell-src-exts, hlint, leksah, leksah-server, ltk, mtl, transformers, vcsgui, vcswrapper, yi
Files
- data/prefs.lkshp +1/−1
- data/prefscoll.lkshp +1/−1
- leksah.cabal +23/−23
- osx/Info.plist +3/−3
- osx/leksah.bundle +10/−7
- osx/makedmg.sh +17/−4
- scripts/clean.sh +1/−0
- scripts/stage.sh +9/−14
- src/IDE/BufferMode.hs +32/−35
- src/IDE/Build.hs +13/−9
- src/IDE/Command.hs +42/−33
- src/IDE/Command/Print.hs +6/−4
- src/IDE/Command/VCS/Common.hs +9/−5
- src/IDE/Command/VCS/Common/Workspaces.hs +4/−1
- src/IDE/Command/VCS/GIT.hs +3/−1
- src/IDE/Command/VCS/Mercurial.hs +3/−1
- src/IDE/Command/VCS/SVN.hs +5/−3
- src/IDE/Completion.hs +27/−23
- src/IDE/Core/State.hs +14/−11
- src/IDE/Core/Types.hs +62/−68
- src/IDE/Debug.hs +38/−34
- src/IDE/Find.hs +74/−67
- src/IDE/ImportTool.hs +71/−65
- src/IDE/Keymap.hs +14/−11
- src/IDE/Leksah.hs +100/−49
- src/IDE/LogRef.hs +25/−24
- src/IDE/Metainfo/Provider.hs +119/−90
- src/IDE/NotebookFlipper.hs +1/−0
- src/IDE/OSX.hs +6/−4
- src/IDE/Package.hs +86/−73
- src/IDE/Pane/Breakpoints.hs +8/−5
- src/IDE/Pane/Errors.hs +2/−2
- src/IDE/Pane/Files.hs +16/−8
- src/IDE/Pane/Grep.hs +14/−12
- src/IDE/Pane/HLint.hs +19/−12
- src/IDE/Pane/Info.hs +12/−5
- src/IDE/Pane/Log.hs +39/−35
- src/IDE/Pane/Modules.hs +118/−98
- src/IDE/Pane/PackageEditor.hs +150/−150
- src/IDE/Pane/PackageFlags.hs +28/−20
- src/IDE/Pane/Preferences.hs +37/−29
- src/IDE/Pane/Search.hs +16/−11
- src/IDE/Pane/SourceBuffer.hs +115/−107
- src/IDE/Pane/Trace.hs +16/−12
- src/IDE/Pane/Variables.hs +22/−21
- src/IDE/Pane/WebKit/Documentation.hs +4/−2
- src/IDE/Pane/WebKit/Output.hs +17/−13
- src/IDE/Pane/Workspace.hs +12/−6
- src/IDE/PaneGroups.hs +1/−0
- src/IDE/Sandbox.hs +8/−5
- src/IDE/Session.hs +11/−7
- src/IDE/SourceCandy.hs +31/−25
- src/IDE/Statusbar.hs +18/−15
- src/IDE/SymbolNavigation.hs +5/−2
- src/IDE/TextEditor/Class.hs +14/−13
- src/IDE/TextEditor/CodeMirror.hs +27/−7
- src/IDE/TextEditor/GtkSourceView.hs +12/−8
- src/IDE/TextEditor/Yi.hs +12/−10
- src/IDE/Utils/ExternalTool.hs +9/−7
- src/IDE/Utils/GUIUtils.hs +19/−16
- src/IDE/Utils/ServerConnection.hs +6/−3
- src/IDE/Workspaces.hs +20/−11
- src/IDE/Workspaces/Writer.hs +8/−5
- src/IDE/YiConfig.hs +63/−86
- tests/IDE/TextEditor/Tests.hs +3/−3
- win32/makeinstaller.sh +66/−66
data/prefs.lkshp view
@@ -46,7 +46,7 @@ Paths under which haskell sources for packages may be found: [] Unpack source for cabal packages to:- Just "~/.leksah-0.13/packageSources"+ Just "~/.leksah-0.14/packageSources" URL from which to download prebuilt metadata: "http://www.leksah.org" Strategy for downloading prebuilt metadata:
data/prefscoll.lkshp view
@@ -1,7 +1,7 @@ Paths under which haskell sources for packages may be found: [] Unpack source for cabal packages to:- Just "~/.leksah-0.13/packageSources"+ Just "~/.leksah-0.14/packageSources" URL from which to download prebuilt metadata: "http://www.leksah.org" Strategy for downloading prebuilt metadata:
leksah.cabal view
@@ -1,5 +1,5 @@ name: leksah-version: 0.13.4.3+version: 0.14.0.0 cabal-version: >=1.10 build-type: Simple license: GPL@@ -207,12 +207,12 @@ if os(osx) if flag(gtk3)- build-depends: gtk3-mac-integration >= 0.2.0.0 && <0.3+ build-depends: gtk3-mac-integration >= 0.3.0.0 && <0.4 else- build-depends: gtk-mac-integration >= 0.2.0.0 && <0.3+ build-depends: gtk-mac-integration >= 0.3.0.0 && <0.4 if flag(yi)- build-depends: yi >=0.8.1 && <0.9+ build-depends: yi >=0.8.1 && <0.10 cpp-options: -DLEKSAH_WITH_YI if flag(yi) && flag(dyre)@@ -223,10 +223,10 @@ ghc-options: -threaded if flag(gtk3)- build-depends: gtk3 >=0.12.4 && <0.13, gtksourceview3 >=0.10.0 && <0.13+ build-depends: gtk3 >=0.13.0.0 && <0.14, gtksourceview3 >=0.13.0.0 && <0.14 cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3 else- build-depends: gtk >=0.12.4 && <0.13, gtksourceview2 >=0.10.0 && <0.13+ build-depends: gtk >=0.13.0.0 && <0.14, gtksourceview2 >=0.13.0.0 && <0.14 if flag(webkit) if flag(gtk3)@@ -246,18 +246,18 @@ build-depends: Cabal >=1.10.2.0 && <1.22, base >=4.0.0.0 && <4.8, binary >=0.5.0.0 && <0.8, bytestring >=0.9.0.1 && <0.11, containers >=0.2.0.0 && <0.6, directory >=1.0.0.2 && <3.1,- filepath >=1.1.0.1 && <1.4, glib >=0.10 && <0.13,- mtl >=1.1.0.2 && <2.2, old-time >=1.0.0.1 && <1.2,+ filepath >=1.1.0.1 && <1.4, glib >=0.13.0.0 && <0.14,+ mtl >=1.1.0.2 && <2.3, 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 && <1.3, regex-base ==0.93.*, utf8-string >=0.3.1.1 && <0.4, array >=0.2.0.0 && <0.6,- time >=0.1 && <1.5, ltk >= 0.13.2.0 && <0.14, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4,- hslogger >= 1.0.7 && <1.3, leksah-server >=0.13.1.0 && <0.14, network >= 2.2 && <3.0,- ghc >=6.10.1 && <7.9, strict >= 0.3.2 && <0.4, conduit >= 1.0.8 && <1.1, text >= 0.11.1.5 && < 1.2,- gio >=0.12.2 && <0.13, transformers >=0.2.2.0 && <0.4,+ regex-tdfa >=1.1 && <1.3, regex-tdfa-text, regex-base ==0.93.*, utf8-string >=0.3.1.1 && <0.4, array >=0.2.0.0 && <0.6,+ time >=0.1 && <1.5, ltk >= 0.14.0.0 && <0.15, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4,+ hslogger >= 1.0.7 && <1.3, leksah-server >=0.14.0.0 && <0.15, network >= 2.2 && <3.0,+ ghc >=6.10.1 && <7.9, strict >= 0.3.2 && <0.4, conduit >= 1.0.8 && <1.2, text >= 0.11.1.5 && < 1.2,+ gio >=0.13.0.0 && <0.14, transformers >=0.2.2.0 && <0.5, executable-path >=0.0.3 && <0.1,- vcsgui >=0.0.4 && < 0.1, vcswrapper >=0.0.4 && < 0.1,- QuickCheck >=2.4.2 && <2.7, haskell-src-exts >=1.13.5 && <1.15,- hlint >=1.8.59 && <1.9, vado >=0.0.1 && <0.1, shakespeare >=2.0.0.1 && <2.1+ vcsgui >=0.1.0 && < 0.2, vcswrapper >=0.1.0 && < 0.2,+ QuickCheck >=2.4.2 && <2.8, haskell-src-exts >=1.13.5 && <1.16,+ hlint >=1.8.59 && <1.10, vado >=0.0.1 && <0.1, shakespeare >=2.0.0.1 && <2.1 exposed-modules: IDE.Leksah IDE.Completion IDE.ImportTool IDE.Find IDE.Sandbox IDE.Session IDE.Command IDE.Keymap IDE.Utils.GUIUtils IDE.SymbolNavigation IDE.Package IDE.YiConfig IDE.OSX@@ -303,7 +303,7 @@ ghc-options: -threaded hs-source-dirs: main- build-depends: leksah == 0.13.4.3, base >= 4.0.0.0 && <=4.8, gtk3 -any+ build-depends: leksah == 0.14.0.0, base >= 4.0.0.0 && <=4.8, gtk3 -any if os(linux) && flag(loc) cpp-options: -DLOCALIZATION build-depends: hgettext, setlocale@@ -322,14 +322,14 @@ if !flag(webkit) buildable: False else- build-depends: leksah ==0.13.4.3, base >=4.0.0.0 && <=4.8,+ build-depends: leksah ==0.14.0.0, base >=4.0.0.0 && <=4.8, jsaddle -any, ghcjs-dom -any if flag(gtk3)- build-depends: gtk3 >=0.12.4 && <0.13, gtksourceview3 >=0.10.0 && <0.13,+ build-depends: gtk3 >=0.13.0.0 && <0.14, gtksourceview3 >=0.13.0.0 && <0.14, webkitgtk3 -any, webkitgtk3-javascriptcore -any cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3 else- build-depends: gtk >=0.12.4 && <0.13, gtksourceview2 >=0.10.0 && <0.13,+ build-depends: gtk >=0.13.0.0 && <0.14, gtksourceview2 >=0.13.0.0 && <0.14, webkit -any, webkit-javascriptcore -any main-is: Main.hs@@ -339,14 +339,14 @@ test-suite tests build-depends: base >=4.0.0.0 && <4.8, Cabal >=1.10.2.0 && <1.22,- QuickCheck >=2.4.2 && <2.7, leksah ==0.13.4.3,+ QuickCheck >=2.4.2 && <2.8, leksah ==0.14.0.0, containers, ltk, leksah-server, hslogger, transformers, glib, monad-loops if flag(gtk3)- build-depends: gtk3 >=0.12.4 && <0.13, gtksourceview3 >=0.10.0 && <0.13, webkitgtk3 -any+ build-depends: gtk3 >=0.13.0.0 && <0.14, gtksourceview3 >=0.13.0.0 && <0.14, webkitgtk3 -any cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3 else- build-depends: gtk >=0.12.4 && <0.13, gtksourceview2 >=0.10.0 && <0.13, webkit -any+ build-depends: gtk >=0.13.0.0 && <0.14, gtksourceview2 >=0.13.0.0 && <0.14, webkit -any if flag(yi) build-depends: yi >=0.6.6.1 && <0.7 type: exitcode-stdio-1.0
osx/Info.plist view
@@ -7,7 +7,7 @@ <key>CFBundleExecutable</key> <string>Leksah</string> <key>CFBundleGetInfoString</key>- <string>0.13.0.0</string>+ <string>0.14.0.0</string> <key>CFBundleIconFile</key> <string>leksah.icns</string> <key>CFBundleIdentifier</key>@@ -17,11 +17,11 @@ <key>CFBundlePackageType</key> <string>APPL</string> <key>CFBundleShortVersionString</key>- <string>0.13.0.0</string>+ <string>0.14.0.0</string> <key>CFBundleSignature</key> <string>????</string> <key>CFBundleVersion</key>- <string>0.13.0.0</string>+ <string>0.14.0.0</string> <key>NSHumanReadableCopyright</key> <string>2007-2011 Jürgen Nicklisch-Franken, GNU General Public License.</string> <key>LSMinimumSystemVersion</key>
osx/leksah.bundle view
@@ -13,8 +13,11 @@ either define your own or just hardcode the path here. --> <prefix name="default">${env:JHBUILD_PREFIX}</prefix>+ <prefix name="leksah-bin">${env:LEKSAH_BIN_DIR}</prefix> <prefix name="leksah">${env:LEKSAH_PREFIX}</prefix>+ <prefix name="leksah-server-bin">${env:LEKSAH_SERVER_BIN_DIR}</prefix> <prefix name="leksah-server">${env:LEKSAH_SERVER_PREFIX}</prefix>+ <prefix name="vcsgui-bin">${env:VCSGUI_BIN_DIR}</prefix> <prefix name="vcsgui">${env:VCSGUI_PREFIX}</prefix> <prefix name="hlint">${env:HLINT_PREFIX}</prefix> @@ -54,12 +57,12 @@ --> <plist>${project}/Info.plist</plist> - <main-binary>${prefix:leksah}/bin/leksah</main-binary>+ <main-binary>${prefix:leksah-bin}/bin/leksah</main-binary> - <binary>${prefix:leksah-server}/bin/leksahecho</binary>- <binary>${prefix:leksah-server}/bin/leksah-server</binary>- <binary>${prefix:vcsgui}/bin/vcsgui</binary>- <binary>${prefix:vcsgui}/bin/vcsgui-askpass</binary>+ <binary>${prefix:leksah-server-bin}/bin/leksahecho</binary>+ <binary>${prefix:leksah-server-bin}/bin/leksah-server</binary>+ <binary>${prefix:vcsgui-bin}/bin/vcsgui</binary>+ <binary>${prefix:vcsgui-bin}/bin/vcsgui-askpass</binary> <!-- Copy in the input methods. Dunno if they actually work with OSX. Note the ${gtkdir} macro, which expands to the correct@@ -132,11 +135,11 @@ </data> <data dest="${bundle}/Contents/Resources/share/leksah">- ${prefix:leksah}/share+ ${prefix:leksah} </data> <data dest="${bundle}/Contents/Resources/share/hlint">- ${prefix:hlint}/share+ ${prefix:hlint} </data> <!-- Copy in the themes data. You may want to trim this to save space
osx/makedmg.sh view
@@ -5,11 +5,24 @@ . scripts/stage.sh || exit export GHC_USER_PREFIX=$HOME/Library/Haskell/ghc-`ghc$GHCVERSION --numeric-version`/lib-export LEKSAH_PREFIX=$GHC_USER_PREFIX/$LEKSAH_X_X_X_X-export LEKSAH_SERVER_PREFIX=$GHC_USER_PREFIX/$LEKSAH_SERVER_X_X_X_X-export VCSGUI_PREFIX=$GHC_USER_PREFIX/`ghc-pkg$GHCVERSION list |grep '^ *vcsgui-' | head -n1 | tr -d ' \n'`+export LEKSAH_BIN_DIR=$GHC_USER_PREFIX/$LEKSAH_X_X_X_X+export LEKSAH_PREFIX=$GHC_USER_PREFIX/$LEKSAH_X_X_X_X/share+export LEKSAH_SERVER_BIN_DIR=$GHC_USER_PREFIX/$LEKSAH_SERVER_X_X_X_X+export LEKSAH_SERVER_PREFIX=$GHC_USER_PREFIX/$LEKSAH_SERVER_X_X_X_X/share+export VCSGUI_BIN_DIR=$GHC_USER_PREFIX/`ghc-pkg$GHCVERSION list |grep '^ *vcsgui-' | head -n1 | tr -d ' \n'`+export VCSGUI_PREFIX=$GHC_USER_PREFIX/`ghc-pkg$GHCVERSION list |grep '^ *vcsgui-' | head -n1 | tr -d ' \n'`/share export HLINT_PREFIX=$GHC_USER_PREFIX/`ghc-pkg$GHCVERSION list |grep '^ *hlint-' | head -n1 | tr -d ' \n'` +#export SANDBOX_BIN_DIR=$PWD/.cabal-sandbox+#export SANDBOX_SHARE=$PWD/.cabal-sandbox/share/x86_64-osx-ghc-`ghc$GHCVERSION --numeric-version`+#export LEKSAH_BIN_DIR=$SANDBOX_BIN_DIR+#export LEKSAH_PREFIX=$SANDBOX_SHARE/$LEKSAH_X_X_X_X+#export LEKSAH_SERVER_BIN_DIR=$SANDBOX_BIN_DIR+#export LEKSAH_SERVER_PREFIX=$SANDBOX_SHARE/$LEKSAH_SERVER_X_X_X_X+#export VCSGUI_BIN_DIR=$SANDBOX_BIN_DIR+#export VCSGUI_PREFIX=$SANDBOX_SHARE/`ghc-pkg$GHCVERSION list |grep '^ *vcsgui-' | head -n1 | tr -d ' \n'`+#export HLINT_PREFIX=$SANDBOX_SHARE/`ghc-pkg$GHCVERSION list |grep '^ *hlint-' | head -n1 | tr -d ' \n'`+ sed -e 's|TextView Font: *\"Monospace 10\"|TextView Font: "Monospace 14"|' -e 's|Browser: *\"firefox\"|Browser: \"open\"|' <data/prefs.lkshp >osx/prefs.lkshp sed -e 's|\<ctrl\>|\<meta\>|' \@@ -58,5 +71,5 @@ if test -e "$LEKSAH_DMG"; then rm "$LEKSAH_DMG" fi-hdiutil create -size 400m -srcfolder "Leksah" "$LEKSAH_DMG" || exit+hdiutil create -size 500m -srcfolder "Leksah" "$LEKSAH_DMG" || exit
scripts/clean.sh view
@@ -15,6 +15,7 @@ ghc-pkg$GHCVERSION unregister --force webkit || true ghc-pkg$GHCVERSION unregister --force webkitgtk3 || true ghc-pkg$GHCVERSION unregister --force gtk-mac-integration || true+ghc-pkg$GHCVERSION unregister --force gtk3-mac-integration || true ghc-pkg$GHCVERSION unregister --force gtk || true ghc-pkg$GHCVERSION unregister --force gtk3 || true ghc-pkg$GHCVERSION unregister --force pango || true
scripts/stage.sh view
@@ -16,9 +16,15 @@ echo Staging Leksah in $GTK_PREFIX +# cabal sandbox init || true+# (cd vendor/yi/yi && cabal sandbox init --sandbox=../../../.cabal-sandbox) || true+# (cd vendor/ltk && cabal sandbox init --sandbox=../../.cabal-sandbox) || true+# (cd vendor/leksah-server && cabal sandbox init --sandbox=../../.cabal-sandbox) || true+# cabal sandbox add-source ./vendor/ltk ./vendor/leksah-server ./vendor/yi/yi || true+ # These don't like all the extra options we pass (CPPFLAGS and --extra-lib-dirs) # Gtk2Hs needs the latest Cabal to install properly-cabal install --with-ghc=ghc$GHCVERSION -j4 text parsec network uniplate Cabal --constraint='text>=0.11.3.1' --constraint='parsec>=3.1.3' || true+# cabal install --with-ghc=ghc$GHCVERSION -j4 text parsec network uniplate Cabal --constraint='text>=0.11.3.1' --constraint='parsec>=3.1.3' --constraint='ghc -any' || true # Needed for installing curl package on windows export CPPFLAGS=`pkg-config --cflags-only-I libcurl`@@ -26,21 +32,10 @@ # Only used by OS X # export DYLD_LIBRARY_PATH="/System/Library/Frameworks/ApplicationServices.framework/Versions/A/Frameworks/ImageIO.framework/Versions/A/Resources:$GTK_PREFIX/lib:$DYLD_LIBRARY_PATH" -echo https://github.com/leksah/ltk > sources.txt-echo https://github.com/leksah/leksah-server >> sources.txt--# echo ./vendor/gtk2hs >> sources.txt-echo ./ >> sources.txt- if test "`uname`" = "Darwin"; then- cabal install gtk3 ghcjs-dom jsaddle --with-ghc=ghc$GHCVERSION -j4 -fhave-quartz-gtk -fwebkit --with-gcc=gcc-mp-4.8 || exit- cabal-meta install --with-ghc=ghc$GHCVERSION -j4 -flibcurl --with-gcc=gcc-mp-4.8 || exit+ cabal install ./ ./vendor/ltk ./vendor/leksah-server ./vendor/yi/yi gtk3 ghcjs-dom jsaddle vendor/haskellVCSWrapper/vcswrapper vendor/haskellVCSGUI/vcsgui --with-ghc=ghc$GHCVERSION -j4 -fhave-quartz-gtk -fwebkit -flibcurl -fyi -fpango --with-gcc=gcc-mp-4.8 || exit else- HPDIR=`which ghc` || exit- HPDIR=`dirname "$HPDIR"` || exit- HPDIR=`dirname "$HPDIR"` || exit- cabal install gtk3 ghcjs-dom jsaddle --with-ghc=ghc$GHCVERSION -j4 --extra-lib-dirs="$HPDIR"/mingw/lib --extra-lib-dirs=/c/MinGWRPM/lib -fwebkit --force-reinstalls || bash || exit- cabal-meta install --with-ghc=ghc$GHCVERSION -j4 --extra-lib-dirs="$HPDIR"/mingw/lib --extra-lib-dirs=/c/MinGWRPM/lib -flibcurl --force-reinstalls || bash || exit+ cabal install ./ ./vendor/ltk ./vendor/leksah-server ./vendor/yi/yi gtk3 ghcjs-dom jsaddle vendor/haskellVCSWrapper/vcswrapper vendor/haskellVCSGUI/vcsgui --with-ghc=ghc$GHCVERSION -j4 -fwebkit -flibcurl --force-reinstalls || bash || exit # if [ "$GHC_VER" != "7.0.3" ] && [ "$GHC_VER" != "7.0.4" ] && [ "$GHC_VER" != "7.6.1" ]; then # echo https://github.com/yi-editor/yi.git >> sources.txt # export LEKSAH_CONFIG_ARGS="$LEKSAH_CONFIG_ARGS -fyi -f-vty -f-dyre -fpango"
src/IDE/BufferMode.hs view
@@ -1,4 +1,11 @@-{-# LANGUAGE CPP, FlexibleInstances, DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses, Rank2Types, GADTs, FlexibleContexts, ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.BufferMode@@ -40,7 +47,10 @@ #if MIN_VERSION_directory(1,2,0) import Data.Time (UTCTime) #endif-+import Data.Text (Text)+import Data.Monoid ((<>))+import qualified Data.Text as T+ (isPrefixOf, lines, unlines, count, isInfixOf) -- * Buffer Basics @@ -49,7 +59,7 @@ -- data IDEBuffer = forall editor. TextEditor editor => IDEBuffer { fileName :: Maybe FilePath-, bufferName :: String+, bufferName :: Text , addedIndex :: Int , sourceView :: EditorView editor , scrolledWindow :: ScrolledWindow@@ -69,7 +79,7 @@ paneId b = "" data BufferState = BufferState FilePath Int- | BufferStateTrans String String Int+ | BufferStateTrans Text Text Int deriving(Eq,Ord,Read,Show,Typeable) maybeActiveBuf :: IDEM (Maybe IDEBuffer)@@ -118,7 +128,7 @@ mbI <- liftIO $ notebookPageNum nb (scrolledWindow ideBuf) case mbI of Nothing -> liftIO $ do- sysMessage Normal $ bufferName ideBuf ++ " notebook page not found: unexpected"+ sysMessage Normal $ bufferName ideBuf <> " notebook page not found: unexpected" return def Just i -> do ebuf <- liftIDE $ getBuffer v@@ -140,16 +150,16 @@ -- * Buffer Modes data Mode = Mode {- modeName :: String,+ modeName :: Text, modeEditComment :: IDEAction, modeEditUncomment :: IDEAction,- modeSelectedModuleName :: IDEM (Maybe String),- modeEditToCandy :: (String -> Bool) -> IDEAction,- modeTransformToCandy :: TextEditor editor => (String -> Bool) -> EditorBuffer editor -> IDEAction,+ modeSelectedModuleName :: IDEM (Maybe Text),+ modeEditToCandy :: (Text -> Bool) -> IDEAction,+ modeTransformToCandy :: TextEditor editor => (Text -> Bool) -> EditorBuffer editor -> IDEAction, modeEditFromCandy :: IDEAction,- modeEditKeystrokeCandy :: Maybe Char -> (String -> Bool) -> IDEAction,- modeEditInsertCode :: TextEditor editor => String -> EditorIter editor -> EditorBuffer editor -> IDEAction,- modeEditInCommentOrString :: String -> Bool+ modeEditKeystrokeCandy :: Maybe Char -> (Text -> Bool) -> IDEAction,+ modeEditInsertCode :: TextEditor editor => Text -> EditorIter editor -> EditorBuffer editor -> IDEAction,+ modeEditInCommentOrString :: Text -> Bool } @@ -199,16 +209,9 @@ keystrokeCandy ct c ebuf inCommentOrString, modeEditInsertCode = \ str iter buf -> insert buf iter str,- modeEditInCommentOrString = \ line ->- if isInfixOf "--" line- then True- else let indices = elemIndices '"' line- in if length indices == 0- then False- else if even (length indices)- then False- else True-}+ modeEditInCommentOrString = \ line -> ("--" `T.isInfixOf` line)+ || not (even $ T.count "\"" line)+ } literalHaskellMode = Mode { modeName = "Literal Haskell",@@ -250,16 +253,10 @@ inActiveBufContext () $ \_ _ ebuf _ _ -> do keystrokeCandy ct c ebuf inCommentOrString, modeEditInsertCode = \ str iter buf ->- insert buf iter (unlines $ map (\ s -> "> " ++ s) $ lines str),- modeEditInCommentOrString = \ line ->- if not (isPrefixOf ">" line)- then True- else let indices = elemIndices '"' line- in if length indices == 0- then False- else if even (length indices)- then False- else True }+ insert buf iter (T.unlines $ map (\ s -> "> " <> s) $ T.lines str),+ modeEditInCommentOrString = \ line -> not (T.isPrefixOf ">" line)+ || not (even $ T.count "\"" line)+ } cabalMode = Mode { modeName = "Cabal",@@ -283,7 +280,7 @@ modeEditFromCandy = return (), modeEditKeystrokeCandy = \ _ _ -> return (), modeEditInsertCode = \ str iter buf -> insert buf iter str,- modeEditInCommentOrString = \ str -> isPrefixOf "--" str+ modeEditInCommentOrString = \ str -> T.isPrefixOf "--" str } @@ -315,7 +312,7 @@ editUncomment :: IDEAction editUncomment = withCurrentMode () modeEditUncomment -selectedModuleName :: IDEM (Maybe String)+selectedModuleName :: IDEM (Maybe Text) selectedModuleName = withCurrentMode Nothing modeSelectedModuleName editToCandy :: IDEAction@@ -328,7 +325,7 @@ editKeystrokeCandy c = withCurrentMode () (\m -> modeEditKeystrokeCandy m c (modeEditInCommentOrString m)) -editInsertCode :: TextEditor editor => EditorBuffer editor -> EditorIter editor -> String -> IDEAction+editInsertCode :: TextEditor editor => EditorBuffer editor -> EditorIter editor -> Text -> IDEAction editInsertCode buffer iter str = withCurrentMode () (\ m -> modeEditInsertCode m str iter buffer)
src/IDE/Build.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC #-} ----------------------------------------------------------------------------- --@@ -40,12 +41,15 @@ packageTest', packageDoc') import IDE.Core.Types (IDEEvent(..), Prefs(..), IDE(..), WorkspaceAction)-import Distribution.Text (Text(..)) import Control.Event (EventSource(..)) import Control.Monad.Trans.Reader (ask) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad (void) import Control.Arrow ((***))+import Data.Text (Text)+import Distribution.Text (disp)+import Data.Monoid ((<>))+import qualified Data.Text as T (pack, unpack) -- import Debug.Trace (trace) trace a b = b@@ -80,7 +84,7 @@ | MoRegister | MoClean | MoDocu- | MoOther String+ | MoOther Text | MoMetaInfo -- rebuild meta info for workspace | MoComposed [MakeOp] deriving (Eq,Ord,Show)@@ -130,7 +134,7 @@ constrMakeChain ms@MakeSettings{msMakeMode = makeMode} Workspace{wsPackages = packages, wsNobuildPack = noBuilds} targets firstOp restOp finishOp =- trace ("topsorted: " ++ showTopSorted topsorted)+ trace (T.unpack $ "topsorted: " <> showTopSorted topsorted) constrElem targets topsorted depGraph ms noBuilds firstOp restOp finishOp False where@@ -216,7 +220,7 @@ -- | Construct a dependency graph for a package -- pointing to the packages the subject package depends on constrParentGraph :: [IDEPackage] -> MakeGraph-constrParentGraph targets = trace ("parentGraph : " ++ showGraph parGraph) parGraph+constrParentGraph targets = trace (T.unpack $ "parentGraph : " <> showGraph parGraph) parGraph where parGraph = Map.fromList $ map (\ p -> (p,nub $ mapMaybe (depToTarget targets)(ipdDepends p))) targets@@ -224,18 +228,18 @@ -- | Construct a dependency graph for a package -- pointing to the packages which depend on the subject package constrDepGraph :: [IDEPackage] -> MakeGraph-constrDepGraph packages = trace ("depGraph : " ++ showGraph depGraph) depGraph+constrDepGraph packages = trace (T.unpack $ "depGraph : " <> showGraph depGraph) depGraph where depGraph = reverseGraph (constrParentGraph packages) -showGraph :: MakeGraph -> String+showGraph :: MakeGraph -> Text showGraph mg =- show+ T.pack $ show $ map (\(k,v) -> (disp (ipdPackageId k), map (disp . ipdPackageId) v)) $ Map.toList mg -showTopSorted :: [IDEPackage] -> String-showTopSorted = show . map (disp .ipdPackageId)+showTopSorted :: [IDEPackage] -> Text+showTopSorted = T.pack . show . map (disp .ipdPackageId) -- | Calculates for every dependency a target (or not)
src/IDE/Command.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} ----------------------------------------------------------------------------- --@@ -104,7 +106,6 @@ import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad (unless, when) import Control.Monad.Trans.Reader (ask)-import Text.Printf (printf) import System.Log.Logger (debugM) import Foreign.C.Types (CInt(..)) import Foreign.Ptr (Ptr(..))@@ -113,8 +114,16 @@ import IDE.Session (saveSessionAs, loadSession, saveSession, sessionClosePane, loadSessionPrompt, saveSessionAsPrompt, viewFullScreen, viewDark)-import qualified Data.Text as T (pack)+import qualified Data.Text as T (unpack, pack)+import Data.Text (Text)+import qualified Data.Text.IO as T (readFile)+import Data.Monoid (Monoid(..), (<>))+import qualified Text.Printf as S (printf)+import Text.Printf (PrintfType) +printf :: PrintfType r => Text -> r+printf = S.printf . T.unpack+ foreign import ccall safe "gtk_toolbar_set_icon_size" gtk_toolbar_set_icon_size :: Ptr Toolbar -> CInt -> IO () @@ -465,7 +474,7 @@ ,AD "Help" (__ "_Help") Nothing Nothing (return ()) [] False ,AD "HelpDebug" (__ "Debug") Nothing Nothing (do pack <- readIDE activePack- ideMessage Normal (show pack)) [] False+ ideMessage Normal (T.pack $ show pack)) [] False -- ,AD "HelpDebug2" "Debug2" (Just "<Ctrl>d") Nothing dbgInstalledPackageInfo [] False ,AD "HelpManual" (__ "Manual") Nothing Nothing (openBrowser "http://leksah.org/leksah_manual.pdf") [] False ,AD "HelpHomepage" (__ "Homepage") Nothing Nothing (openBrowser "http://leksah.org") [] False@@ -486,11 +495,11 @@ -- -- | The menu description in XML Syntax as defined by GTK ---menuDescription :: IO String+menuDescription :: IO Text menuDescription = do dataDir <- getDataDir prefsPath <- getConfigFilePathForLoad "leksah.menu" Nothing dataDir- readFile prefsPath+ T.readFile prefsPath updateRecentEntries :: IDEAction updateRecentEntries = do@@ -503,7 +512,7 @@ mapM_ (\s -> do fe <- doesFileExist s when fe $ do- mi <- menuItemNewWithLabel s+ mi <- menuItemNewWithLabel $ T.pack s mi `on` menuItemActivate $ reflectIDE (fileOpenThis s) ideR menuShellAppend recentFilesMenu mi) recentFiles' oldSubmenu <- menuItemGetSubmenu recentFilesItem@@ -516,7 +525,7 @@ mapM_ (\s -> do fe <- doesFileExist s when fe $ do- mi <- menuItemNewWithLabel s+ mi <- menuItemNewWithLabel $ T.pack s mi `on` menuItemActivate $ reflectIDE (workspaceOpenThis True (Just s) >> showWorkspace) ideR menuShellAppend recentWorkspacesMenu mi) recentWorkspaces' oldSubmenu <- menuItemGetSubmenu recentWorkspacesItem@@ -530,9 +539,9 @@ -- -- | Building the Menu ---makeMenu :: UIManager -> [ActionDescr IDERef] -> String -> IDEAction+makeMenu :: UIManager -> [ActionDescr IDERef] -> Text -> IDEAction makeMenu uiManager actions menuDescription = reifyIDE (\ideR -> do- actionGroupGlobal <- actionGroupNew "global"+ actionGroupGlobal <- actionGroupNew ("global" :: Text) mapM_ (actm ideR actionGroupGlobal) actions uiManagerInsertActionGroup uiManager actionGroupGlobal 1 uiManagerAddUiFromString uiManager menuDescription@@ -540,8 +549,8 @@ where actm ideR ag (AD name label tooltip stockId ideAction accs isToggle) = do let (acc,accString) = if null accs- then (Just "", "=" ++ name)- else (Just (head accs), head accs ++ "=" ++ name)+ then (Just "", "=" <> name)+ else (Just (head accs), head accs <> "=" <> name) if isToggle then do act <- toggleActionNew name label tooltip stockId@@ -560,11 +569,11 @@ -- getMenuAndToolbars :: UIManager -> IO (AccelGroup, MenuBar, Toolbar) getMenuAndToolbars uiManager = do accGroup <- uiManagerGetAccelGroup uiManager- mbMenu <- uiManagerGetWidget uiManager "/ui/menubar"+ mbMenu <- uiManagerGetWidget uiManager ("/ui/menubar" :: Text) let menu = case mbMenu of Just it -> castToMenuBar it Nothing -> throwIDE (__ "Menu>>makeMenu: failed to create menubar")- mbToolbar <- uiManagerGetWidget uiManager "/ui/toolbar"+ mbToolbar <- uiManagerGetWidget uiManager ("/ui/toolbar" :: Text) let toolbar = case mbToolbar of Just it -> castToToolbar it Nothing -> throwIDE (__ "Menu>>makeMenu: failed to create toolbar")@@ -658,15 +667,15 @@ aboutDialog = do d <- aboutDialogNew dd <- getDataDir- license <- catch (readFile $ dd </> __ "LICENSE") (\ (_ :: SomeException) -> return "")- set d [ aboutDialogName := "Leksah"- , aboutDialogVersion := showVersion version+ license <- catch (T.readFile $ dd </> T.unpack (__ "LICENSE")) (\ (_ :: SomeException) -> return "")+ set d [ aboutDialogName := ("Leksah" :: Text)+ , aboutDialogVersion := T.pack $ showVersion version , aboutDialogCopyright := __ "Copyright 2007-2011 Jürgen Nicklisch-Franken, Hamish Mackenzie"- , aboutDialogComments := __ "An integrated development environement (IDE) for the " +++ , aboutDialogComments := __ "An integrated development environement (IDE) for the " <> __ "programming language Haskell and the Glasgow Haskell Compiler" , aboutDialogLicense := Just license- , aboutDialogWebsite := "http://leksah.org/"- , aboutDialogAuthors := ["Jürgen Nicklisch-Franken","Hamish Mackenzie"] ]+ , aboutDialogWebsite := ("http://leksah.org/" :: Text)+ , aboutDialogAuthors := ["Jürgen Nicklisch-Franken","Hamish Mackenzie" :: Text] ] dialogRun d widgetDestroy d return ()@@ -683,12 +692,12 @@ "ide_debug", "ide_step", "ide_local", "ide_module", "ide_continue", "ide_rebuild_meta", "ide_empty","ide_source_local", "ide_js"] iconFactoryAddDefault iconFactory)- (\(e :: SomeException) -> getDataDir >>= \dataDir -> throwIDE (printf (__ "Can't load icons from %s %s") dataDir (show e)))+ (\(e :: SomeException) -> getDataDir >>= \dataDir -> throwIDE (T.pack $ printf (__ "Can't load icons from %s %s") dataDir (show e))) where loadIcon dataDir iconFactory name = do- pb <- pixbufNewFromFile $ dataDir </> "pics" </> (name ++ ".png")+ pb <- pixbufNewFromFile $ dataDir </> "pics" </> (name <> ".png") icon <- iconSetNewFromPixbuf pb- iconFactoryAdd iconFactory name icon+ iconFactoryAdd iconFactory (T.pack name) icon setSensitivity :: [(SensitivityMask, Bool)] -> IDEAction setSensitivity = mapM_ setSensitivitySingle@@ -715,7 +724,7 @@ getActionsFor SensitivityInterpreting = getActionsFor' ["QuitDebugger"] getActionsFor SensitivityWorkspaceOpen = return [] --TODO add here -getActionsFor' :: [String] -> IDEM[Action]+getActionsFor' :: [Text] -> IDEM[Action] getActionsFor' l = do r <- mapM getActionFor l return (catMaybes r)@@ -724,7 +733,7 @@ uiManager' <- getUiManager actionGroups <- liftIO $ uiManagerGetActionGroups uiManager' res <- liftIO $ actionGroupGetAction (head actionGroups) string- when (isNothing res) $ ideMessage Normal $ printf (__ "Can't find UI Action %s") string+ when (isNothing res) $ ideMessage Normal $ T.pack $ printf (__ "Can't find UI Action %s") (T.unpack string) return res getAdditionalActionsFor :: SensitivityMask -> [Bool -> IDEAction]@@ -752,7 +761,7 @@ when iconExists $ windowSetIconFromFile win iconPath vb <- vBoxNew False 1 -- Top-level vbox- widgetSetName vb "topBox"+ widgetSetName vb ("topBox" :: Text) (acc,menu,toolbar) <- getMenuAndToolbars uiManager' boxPackStart vb menu PackNatural 0 boxPackStart vb toolbar PackNatural 0@@ -821,7 +830,7 @@ triggerEventIDE (StatusbarChanged [CompartmentCommand ""]) return False Just map -> do- let sym = printMods mods ++ name+ let sym = printMods mods <> name triggerEventIDE (StatusbarChanged [CompartmentCommand sym]) modifyIDE_ (\ide -> ide{specialKey = Just (map,sym)}) return True@@ -829,19 +838,19 @@ case Map.lookup (keyVal,sort mods) map of Nothing -> do triggerEventIDE (StatusbarChanged [CompartmentCommand- (sym ++ printMods mods ++ name ++ "?")])+ (sym <> printMods mods <> name <> "?")]) return () Just (AD actname _ _ _ ideAction _ _) -> do triggerEventIDE (StatusbarChanged [CompartmentCommand- (sym ++ " " ++ printMods mods ++ name ++ "=" ++ actname)])+ (sym <> " " <> printMods mods <> name <> "=" <> actname)]) ideAction modifyIDE_ (\ide -> ide{specialKey = Nothing}) return True where- printMods :: [Modifier] -> String- printMods = concatMap show+ printMods :: [Modifier] -> Text+ printMods = mconcat . map (T.pack . show) -setSymbol :: String -> Bool -> IDEAction+setSymbol :: Text -> Bool -> IDEAction setSymbol symbol openSource = do currentInfo' <- getWorkspaceInfo search <- getSearch Nothing@@ -874,7 +883,7 @@ postAsyncIDE $ do log <- getLog defaultLogLaunch <- getDefaultLogLaunch- liftIO $ appendLog log defaultLogLaunch (T.pack s) t+ liftIO $ appendLog log defaultLogLaunch s t return () return e) registerEvent stRef "SelectInfo"
src/IDE/Command/Print.hs view
@@ -23,10 +23,12 @@ import IDE.Core.Types import IDE.Core.State import IDE.Utils.Tool (readProcessWithExitCode)+import Data.Text (Text)+import qualified Data.Text as T (pack) data PrintError = PrintError { exitCode :: Int- , stderr :: String+ , stderr :: Text , printCmd :: FilePath } deriving (Read,Show) @@ -37,10 +39,10 @@ printCommand = "lpr" #endif -print :: FilePath -> IO (Either PrintError String)+print :: FilePath -> IO (Either PrintError Text) print fileName = do (ec, out, err) <- readProcessWithExitCode printCommand [fileName] "" case ec of- ExitSuccess -> return $ Right out- ExitFailure i -> return $ Left $ PrintError i err printCommand+ ExitSuccess -> return $ Right (T.pack out)+ ExitFailure i -> return $ Left $ PrintError i (T.pack err) printCommand
src/IDE/Command/VCS/Common.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Command.VCS.Common@@ -20,6 +21,7 @@ import IDE.Core.Types import IDE.Core.State+import IDE.Utils.GUIUtils import qualified IDE.Utils.GUIUtils as GUIUtils import qualified IDE.Workspaces.Writer as Writer import qualified IDE.Command.VCS.Types as Types@@ -37,6 +39,8 @@ import qualified Control.Exception as Exc import Data.Maybe import qualified Data.Map as Map+import Data.Text (Text)+import qualified Data.Text as T (pack) @@ -48,7 +52,7 @@ (oldMenuItems,pw) <- readIDE vcsData packageItem <- case Map.lookup cabalFp oldMenuItems of- Nothing -> liftIO $ Gtk.menuItemNewWithLabel cabalFp+ Nothing -> liftIO . Gtk.menuItemNewWithLabel $ T.pack cabalFp Just menuItem -> return menuItem let newMenuItems = Map.insert cabalFp packageItem oldMenuItems modifyIDE_ (\ide -> ide {vcsData = (newMenuItems,pw)})@@ -56,7 +60,7 @@ packageMenu <- liftIO Gtk.menuNew -- build and set set-up repo action- setupActionItem <- liftIO $ Gtk.menuItemNewWithMnemonic "_Setup Repo"+ setupActionItem <- liftIO $ Gtk.menuItemNewWithMnemonic (__"_Setup Repo") liftIO $ setupActionItem `Gtk.on` Gtk.menuItemActivate $ reflectIDE ( runSetupRepoActionWithContext cabalFp@@ -83,7 +87,7 @@ actionItem `Gtk.on` Gtk.menuItemActivate $ reflectIDE (runActionWithContext action cabalFp) ideR Gtk.menuShellAppend packageMenu actionItem)- mkVCSActions :: VCS.VCSType -> [(String, Types.VCSAction ())]+ mkVCSActions :: VCS.VCSType -> [(Text, Types.VCSAction ())] mkVCSActions VCS.SVN = SVN.mkSVNActions mkVCSActions VCS.GIT = GIT.mkGITActions mkVCSActions VCS.Mercurial = Mercurial.mkMercurialActions@@ -152,7 +156,7 @@ -- | vcs conf for given package in current workspace.-getVCSConf :: FilePath -> IDEM (Either String (Maybe VCSConf))+getVCSConf :: FilePath -> IDEM (Either Text (Maybe VCSConf)) getVCSConf pathToPackage = do mbWorkspace <- readIDE workspace case mbWorkspace of@@ -160,7 +164,7 @@ Just workspace -> getVCSConf' workspace pathToPackage -- | vcs conf for given package in given workspace.-getVCSConf' :: Workspace -> FilePath -> IDEM (Either String (Maybe VCSConf))+getVCSConf' :: Workspace -> FilePath -> IDEM (Either Text (Maybe VCSConf)) getVCSConf' workspace pathToPackage = do let mbConfig = Map.lookup pathToPackage $ packageVcsConf workspace case mbConfig of
src/IDE/Command/VCS/Common/Workspaces.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Command.VCS.Common.Workspaces@@ -41,6 +42,8 @@ import Data.Maybe import Data.List import System.Log.Logger (debugM)+import Data.Monoid ((<>))+import qualified Data.Text as T (unpack, pack) onWorkspaceClose :: IDEAction onWorkspaceClose = do@@ -74,7 +77,7 @@ eErrConf <- Common.getVCSConf' workspace fp case eErrConf of Left error -> do- liftIO $ putStrLn $ "Could not retrieve vcs-conf due to '"++error++"'."+ liftIO . putStrLn . T.unpack $ "Could not retrieve vcs-conf due to '"<>error<>"'." return (p, Nothing) Right mbConf -> case mbConf of Nothing -> do
src/IDE/Command/VCS/GIT.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Command.VCS.GIT@@ -28,6 +29,7 @@ import qualified VCSGui.Git as GitGUI import qualified VCSWrapper.Git as Git+import Data.Text (Text) commitAction :: Types.VCSAction () commitAction = Helper.createActionFromContext GitGUI.showCommitGUI@@ -41,7 +43,7 @@ pullAction :: Types.VCSAction () pullAction = Helper.createActionFromContext $ GitGUI.askPassWrapper GitGUI.pull -mkGITActions :: [(String, Types.VCSAction ())]+mkGITActions :: [(Text, Types.VCSAction ())] mkGITActions = [ ("_Commit", commitAction) ,("_View Log", viewLogAction)
src/IDE/Command/VCS/Mercurial.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Command.VCS.Mercurial@@ -24,6 +25,7 @@ import qualified VCSGui.Mercurial as MercurialGUI import qualified VCSWrapper.Mercurial as Mercurial+import Data.Text (Text) commitAction :: Types.VCSAction () commitAction = Helper.createActionFromContext MercurialGUI.showCommitGUI@@ -37,7 +39,7 @@ pullAction :: Types.VCSAction () pullAction = Helper.createActionFromContext Mercurial.pull -mkMercurialActions :: [(String, Types.VCSAction ())]+mkMercurialActions :: [(Text, Types.VCSAction ())] mkMercurialActions = [ ("_Commit", commitAction) ,("_View Log", viewLogAction)
src/IDE/Command/VCS/SVN.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Command.VCS.SVN@@ -36,6 +37,7 @@ import Control.Monad.Reader(liftIO,ask,lift) import Data.IORef(atomicModifyIORef, IORef) import Data.Either+import Data.Text (Text) commitAction :: Types.VCSAction () commitAction = do@@ -52,7 +54,7 @@ viewLogAction :: Types.VCSAction () viewLogAction = createSVNActionFromContext GUISvn.showLogGUI -mkSVNActions :: [(String, Types.VCSAction ())]+mkSVNActions :: [(Text, Types.VCSAction ())] mkSVNActions = [ ("_Commit", commitAction) ,("_View Log", viewLogAction)@@ -61,7 +63,7 @@ --HELPERS -createSVNActionFromContext :: (Either GUISvn.Handler (Maybe String)+createSVNActionFromContext :: (Either GUISvn.Handler (Maybe Text) -> Wrapper.Ctx()) -> Types.VCSAction () createSVNActionFromContext action = do@@ -71,7 +73,7 @@ Nothing -> Helper.createActionFromContext $ action $ Left $ passwordHandler ide mergeInfo Just mb -> Helper.createActionFromContext $ action $ Right mb where--- passwordHandler :: IORef IDE-> Maybe MergeId -> ((Maybe (Bool, Maybe String)) -> Wrapper.Ctx ())+-- passwordHandler :: IORef IDE-> Maybe MergeId -> ((Maybe (Bool, Maybe Text)) -> Wrapper.Ctx ()) passwordHandler ide mbMergeInfo result = liftIO $ case result of Just (True, pw) -> modifyIDE_' ide (\ide -> ide {vcsData = (mbMergeInfo, Just pw) })
src/IDE/Completion.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Completion@@ -32,6 +32,10 @@ import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Applicative ((<$>)) import IDE.Utils.GUIUtils (getDarkState)+import Data.Text (Text)+import qualified Data.Text as T+ (empty, commonPrefixes, pack, unpack, null, stripPrefix,+ isPrefixOf) complete :: TextEditor editor => EditorView editor -> Bool -> IDEAction complete sourceView always = do@@ -73,7 +77,7 @@ eol <- forwardToLineEndC end line <- getSlice buffer sol eol False - let isImport = "import " `isPrefixOf` line+ let isImport = "import " `T.isPrefixOf` line isIdent a = isAlphaNum a || a == '\'' || a == '_' || (isImport && a == '.') isOp a = isSymbol a || a == ':' || a == '\\' || a == '*' || a == '/' || a == '-' || a == '!' || a == '@' || a == '%' || a == '&' || a == '?'@@ -120,7 +124,7 @@ fontDescriptionFromString str Nothing -> do f <- fontDescriptionNew- fontDescriptionSetFamily f "Monospace"+ fontDescriptionSetFamily f ("Monospace" :: Text) return f liftIO $ widgetModifyFont tree (Just font) @@ -167,7 +171,7 @@ completion = ((width, height), Just (CompletionWindow window tree store))}) updateOptions window tree store sourceView cids isWordChar always -addEventHandling :: TextEditor editor => Window -> EditorView editor -> TreeView -> ListStore String+addEventHandling :: TextEditor editor => Window -> EditorView editor -> TreeView -> ListStore Text -> (Char -> Bool) -> Bool -> IDEM Connections addEventHandling window sourceView tree store isWordChar always = do ideR <- ask@@ -308,7 +312,7 @@ return $ concat [cidsPress, cidsRelease, [ConnectC idButtonPress, ConnectC idMotion, ConnectC idButtonRelease, ConnectC idSelected]] -withWord :: ListStore String -> TreePath -> (String -> IDEM ()) -> IDEM ()+withWord :: ListStore Text -> TreePath -> (Text -> IDEM ()) -> IDEM () withWord store treePath f = (do case treePath of [row] -> (do@@ -318,41 +322,41 @@ _ -> return () ) -replaceWordStart :: TextEditor editor => EditorView editor -> (Char -> Bool) -> String -> IDEM ()+replaceWordStart :: TextEditor editor => EditorView editor -> (Char -> Bool) -> Text -> IDEM () replaceWordStart sourceView isWordChar name = do buffer <- getBuffer sourceView (selStart, selEnd) <- getSelectionBounds buffer start <- findWordStart selStart isWordChar wordStart <- getText buffer start selEnd True- case stripPrefix wordStart name of+ case T.stripPrefix wordStart name of Just extra -> do end <- findWordEnd selEnd isWordChar wordFinish <- getText buffer selEnd end True- case (wordFinish, stripPrefix wordFinish extra) of- (_:_,Just extra2) -> do+ case T.stripPrefix wordFinish extra of+ Just extra2 | not (T.null wordFinish) -> do selectRange buffer end end insert buffer end extra2- _ -> insert buffer selEnd extra- Nothing -> return ()+ _ -> insert buffer selEnd extra+ Nothing -> return () -cancelCompletion :: Window -> TreeView -> ListStore String -> Connections -> IDEAction+cancelCompletion :: Window -> TreeView -> ListStore Text -> Connections -> IDEAction cancelCompletion window tree store connections = do liftIO (do- listStoreClear (store :: ListStore String)+ listStoreClear (store :: ListStore Text) signalDisconnectAll connections widgetHide window ) modifyIDE_ (\ide -> ide{currentState = IsRunning}) -updateOptions :: forall editor. TextEditor editor => Window -> TreeView -> ListStore String -> EditorView editor -> Connections -> (Char -> Bool) -> Bool -> IDEAction+updateOptions :: forall editor. TextEditor editor => Window -> TreeView -> ListStore Text -> EditorView editor -> Connections -> (Char -> Bool) -> Bool -> IDEAction updateOptions window tree store sourceView connections isWordChar always = do result <- tryToUpdateOptions window tree store sourceView False isWordChar always when (not result) $ cancelCompletion window tree store connections -tryToUpdateOptions :: TextEditor editor => Window -> TreeView -> ListStore String -> EditorView editor -> Bool -> (Char -> Bool) -> Bool -> IDEM Bool+tryToUpdateOptions :: TextEditor editor => Window -> TreeView -> ListStore Text -> EditorView editor -> Bool -> (Char -> Bool) -> Bool -> IDEM Bool tryToUpdateOptions window tree store sourceView selectLCP isWordChar always = do ideR <- ask- liftIO $ listStoreClear (store :: ListStore String)+ liftIO $ listStoreClear (store :: ListStore Text) buffer <- getBuffer sourceView (selStart, end) <- getSelectionBounds buffer start <- findWordStart selStart isWordChar@@ -382,10 +386,11 @@ Nothing -> forwardToLineEndC iter Just we -> return we -longestCommonPrefix (x:xs) (y:ys) | x == y = x : longestCommonPrefix xs ys-longestCommonPrefix _ _ = []+longestCommonPrefix a b = case T.commonPrefixes a b of+ Nothing -> T.empty+ Just (p, _, _) -> p -processResults :: TextEditor editor => Window -> TreeView -> ListStore String -> EditorView editor -> String -> [String]+processResults :: TextEditor editor => Window -> TreeView -> ListStore Text -> EditorView editor -> Text -> [Text] -> Bool -> (Char -> Bool) -> Bool -> IDEAction processResults window tree store sourceView wordStart options selectLCP isWordChar always = do case options of@@ -399,14 +404,13 @@ newWordStart <- do if selectLCP && currentWordStart == wordStart && (not $ null options) then do- let lcp = foldl1 longestCommonPrefix options- return lcp+ return $ foldl1 longestCommonPrefix options else return currentWordStart - when (isPrefixOf wordStart newWordStart) $ do+ when (T.isPrefixOf wordStart newWordStart) $ do liftIO $ listStoreClear store- let newOptions = List.filter (isPrefixOf newWordStart) options+ let newOptions = List.filter (T.isPrefixOf newWordStart) options liftIO $ forM_ (take 200 newOptions) (listStoreAppend store) Rectangle startx starty width height <- getIterLocation sourceView start (wWindow, hWindow) <- liftIO $ windowGetSize window
src/IDE/Core/State.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeSynonymInstances, MultiParamTypeClasses, ScopedTypeVariables, CPP,- DeriveDataTypeable #-}+ DeriveDataTypeable, OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Core.State@@ -108,6 +108,9 @@ import qualified Paths_leksah as P import System.Environment.Executable (getExecutablePath) import System.Directory (doesDirectoryExist)+import Data.Text (Text)+import qualified Data.Text as T (unpack)+import Data.Monoid ((<>)) instance PaneMonad IDEM where getFrameState = readIDE frameState@@ -188,7 +191,7 @@ 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 :: Maybe Text -> Maybe Text -> IDEAction trigger s1 s2 = do triggerEventIDE (RecordHistory (PaneSelected s1, PaneSelected s2)) triggerEventIDE (Sensitivity [(SensitivityEditor, False)])@@ -200,7 +203,7 @@ mbI <- liftIO $notebookPageNum nb (getTopWidget pane) case mbI of Nothing -> liftIO $ do- error ("notebook page not found: unexpected " ++ paneName pane ++ " " ++ show panePath)+ error ("notebook page not found: unexpected " ++ T.unpack (paneName pane) ++ " " ++ show panePath) return False Just i -> do deactivatePaneIfActive pane@@ -216,20 +219,20 @@ -- Shall be replaced-sysMessage :: MonadIO m => MessageLevel -> String -> m ()+sysMessage :: MonadIO m => MessageLevel -> Text -> m () sysMessage ml str = liftIO $ do- putStrLn str+ putStrLn $ T.unpack str hFlush stdout -ideMessage :: MonadIDE m => MessageLevel -> String -> m ()+ideMessage :: MonadIDE m => MessageLevel -> Text -> m () ideMessage level str = do liftIO $ sysMessage level str- triggerEventIDE (LogMessage (str ++ "\n") LogTag)+ triggerEventIDE (LogMessage (str <> "\n") LogTag) return () -logMessage :: MonadIDE m => String -> LogTag -> m ()+logMessage :: MonadIDE m => Text -> LogTag -> m () logMessage str tag = do- triggerEventIDE (LogMessage (str ++ "\n") tag)+ triggerEventIDE (LogMessage (str <> "\n") tag) return () -- with hslogger @@ -237,11 +240,11 @@ ---- Exception handling ---- -data IDEException = IDEException String+data IDEException = IDEException Text deriving Typeable instance Show IDEException where- show (IDEException str) = str+ show (IDEException str) = T.unpack str instance Exception IDEException
src/IDE/Core/Types.hs view
@@ -1,15 +1,9 @@-{-# LANGUAGE- CPP- , DisambiguateRecordFields- , ExistentialQuantification- , Rank2Types- , FlexibleInstances- , DeriveDataTypeable- , FlexibleContexts- , DeriveDataTypeable- , TypeSynonymInstances- , MultiParamTypeClasses #-}-+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Core.Data@@ -155,7 +149,7 @@ , prefs :: Prefs -- ^ configuration preferences , workspace :: Maybe Workspace -- ^ may be a workspace (set of packages) , activePack :: Maybe IDEPackage-, activeExe :: Maybe String+, activeExe :: Maybe Text , bufferProjCache :: Map FilePath [IDEPackage] , allLogRefs :: [LogRef] , currentEBC :: (Maybe LogRef, Maybe LogRef, Maybe LogRef)@@ -164,10 +158,10 @@ , packageInfo :: (Maybe (GenScope, GenScope)) -- ^ the second are the imports , workspaceInfo :: (Maybe (GenScope, GenScope)) -- ^ the second are the imports , workspInfoCache :: PackageDescrCache-, handlers :: Map String [(Unique, IDEEvent -> IDEM IDEEvent)] -- ^ event handling table+, handlers :: Map Text [(Unique, IDEEvent -> IDEM IDEEvent)] -- ^ event handling table , currentState :: IDEState , guiHistory :: (Bool,[GUIHistory],Int)-, findbar :: (Bool,Maybe (Toolbar,ListStore String))+, findbar :: (Bool,Maybe (Toolbar,ListStore Text)) , toolbar :: (Bool,Maybe Toolbar) , recentFiles :: [FilePath] , recentWorkspaces :: [FilePath]@@ -176,10 +170,10 @@ , completion :: ((Int, Int), Maybe CompletionWindow) , yiControl :: Yi.Control , server :: Maybe Handle-, vcsData :: (Map FilePath MenuItem, Maybe (Maybe String)) -- menus for packages, password-, logLaunches :: Map.Map String LogLaunchData+, vcsData :: (Map FilePath MenuItem, Maybe (Maybe Text)) -- menus for packages, password+, logLaunches :: Map.Map Text LogLaunchData , autoCommand :: IDEAction-, autoURI :: Maybe String+, autoURI :: Maybe Text } --deriving Show --@@ -275,12 +269,12 @@ data IDEEvent = InfoChanged Bool-- is it the initial = True else False | UpdateWorkspaceInfo- | SelectInfo String Bool -- navigate to source (== True)+ | SelectInfo Text Bool -- navigate to source (== True) | SelectIdent Descr- | LogMessage String LogTag+ | LogMessage Text LogTag | RecordHistory GUIHistory | Sensitivity [(SensitivityMask,Bool)]- | SearchMeta String+ | SearchMeta Text | StartFindInitial | GotoDefinition Descr | LoadSession FilePath@@ -296,7 +290,7 @@ | StatusbarChanged [StatusbarCompartment] | WorkspaceChanged Bool Bool -- ^ showPane updateFileCache -instance Event IDEEvent String where+instance Event IDEEvent Text where getSelector (InfoChanged _) = "InfoChanged" getSelector UpdateWorkspaceInfo = "UpdateWorkspaceInfo" getSelector (LogMessage _ _) = "LogMessage"@@ -320,7 +314,7 @@ getSelector (StatusbarChanged _) = "StatusbarChanged" getSelector (WorkspaceChanged _ _) = "WorkspaceChanged" -instance EventSource IDERef IDEEvent IDEM String where+instance EventSource IDERef IDEEvent IDEM Text where canTriggerEvent _ "InfoChanged" = True canTriggerEvent _ "UpdateWorkspaceInfo" = True canTriggerEvent _ "LogMessage" = True@@ -355,7 +349,7 @@ myUnique _ = do liftIO $ newUnique -instance EventSelector String+instance EventSelector Text -- --------------------------------------------------------------------- -- IDEPackages@@ -366,22 +360,22 @@ , ipdDepends :: [Dependency] , ipdModules :: Map ModuleName BuildInfo , ipdHasLibs :: Bool-, ipdExes :: [String]-, ipdTests :: [String]-, ipdBenchmarks :: [String]+, ipdExes :: [Text]+, ipdTests :: [Text]+, ipdBenchmarks :: [Text] , ipdMain :: [(FilePath, BuildInfo, Bool)] , ipdExtraSrcs :: Set FilePath , ipdSrcDirs :: [FilePath] , ipdExtensions :: [Extension]-, ipdConfigFlags :: [String]-, ipdBuildFlags :: [String]-, ipdTestFlags :: [String]-, ipdHaddockFlags :: [String]-, ipdExeFlags :: [String]-, ipdInstallFlags :: [String]-, ipdRegisterFlags :: [String]-, ipdUnregisterFlags :: [String]-, ipdSdistFlags :: [String]+, ipdConfigFlags :: [Text]+, ipdBuildFlags :: [Text]+, ipdTestFlags :: [Text]+, ipdHaddockFlags :: [Text]+, ipdExeFlags :: [Text]+, ipdInstallFlags :: [Text]+, ipdRegisterFlags :: [Text]+, ipdUnregisterFlags :: [Text]+, ipdSdistFlags :: [Text] , ipdSandboxSources :: [IDEPackage] } deriving (Eq)@@ -403,13 +397,13 @@ -- data Workspace = Workspace { wsVersion :: Int-, wsSaveTime :: String-, wsName :: String+, wsSaveTime :: Text+, wsName :: Text , wsFile :: FilePath , wsPackages :: [IDEPackage] , wsPackagesFiles :: [FilePath] , wsActivePackFile:: Maybe FilePath-, wsActiveExe :: Maybe String+, wsActiveExe :: Maybe Text , wsNobuildPack :: [IDEPackage] , packageVcsConf :: Map FilePath VCSConf -- ^ (FilePath to package, Version-Control-System Configuration) } deriving Show@@ -428,49 +422,49 @@ -- data ActionDescr alpha = AD { name :: ActionString-, label :: String-, tooltip :: Maybe String-, stockID :: Maybe String+, label :: Text+, tooltip :: Maybe Text+, stockID :: Maybe Text , action :: ReaderT alpha IO () , accelerator :: [KeyString] , isToggle :: Bool } -type ActionString = String-type KeyString = String+type ActionString = Text+type KeyString = Text -- -- | Preferences is a data structure to hold configuration data -- data Prefs = Prefs { prefsFormat :: Int- , prefsSaveTime :: String+ , prefsSaveTime :: Text , showLineNumbers :: Bool , rightMargin :: (Bool, Int) , tabWidth :: Int , wrapLines :: Bool- , sourceCandy :: (Bool,String)- , keymapName :: String+ , sourceCandy :: (Bool,Text)+ , keymapName :: Text , forceLineEnds :: Bool , removeTBlanks :: Bool- , textviewFont :: Maybe String- , sourceStyle :: (Bool, String)+ , textviewFont :: Maybe Text+ , sourceStyle :: (Bool, Text) , foundBackground :: Color , matchBackground :: Color , contextBackground :: Color , breakpointBackground :: Color , autoLoad :: Bool- , textEditor :: String- , logviewFont :: Maybe String+ , textEditorType :: Text+ , logviewFont :: Maybe Text , defaultSize :: (Int,Int)- , browser :: String- , pathForCategory :: [(String, PanePath)]+ , browser :: Text+ , pathForCategory :: [(Text, PanePath)] , defaultPath :: PanePath- , categoryForPane :: [(String, String)]+ , categoryForPane :: [(Text, Text)] , packageBlacklist :: [Dependency] , collectAtStart :: Bool , useCtrlTabFlipping :: Bool- , docuSearchURL :: String+ , docuSearchURL :: Text , completeRestricted :: Bool , saveAllBeforeBuild :: Bool , jumpToWarnings :: Bool@@ -485,17 +479,17 @@ , breakOnException :: Bool , breakOnError :: Bool , printBindResult :: Bool- , serverIP :: String+ , serverIP :: Text -- As well used by server , serverPort :: Int , sourceDirectories :: [FilePath] , unpackDirectory :: Maybe FilePath- , retrieveURL :: String+ , retrieveURL :: Text , retrieveStrategy :: RetrieveStrategy , endWithLastConn :: Bool } deriving(Eq,Show) -cabalCommand :: Prefs -> String+cabalCommand :: Prefs -> FilePath cabalCommand p = if useCabalDev p then "cabal-dev" else "cabal" data SearchHint = Forward | Backward | Insert | Delete | Initial@@ -572,16 +566,16 @@ newtype CandyTable = CT (CandyTableForth,CandyTableBack) -type CandyTableForth = [(Bool,String,String)]+type CandyTableForth = [(Bool,Text,Text)] -type CandyTableBack = [(String,String,Int)]+type CandyTableBack = [(Text,Text,Int)] newtype KeymapI = KM (Map ActionString- [(Maybe (Either KeyString (KeyString,KeyString)), Maybe String)])+ [(Maybe (Either KeyString (KeyString,KeyString)), Maybe Text)]) type SpecialKeyTable alpha = Map (KeyVal,[Modifier]) (Map (KeyVal,[Modifier]) (ActionDescr alpha)) -type SpecialKeyCons alpha = Maybe ((Map (KeyVal,[Modifier]) (ActionDescr alpha)),String)+type SpecialKeyCons alpha = Maybe ((Map (KeyVal,[Modifier]) (ActionDescr alpha)),Text) data LogTag = LogTag | ErrorTag | FrameTag | InputTag | InfoTag @@ -591,14 +585,14 @@ data GUIHistory' = ModuleSelected { moduleS :: Maybe ModuleName- , facetS :: Maybe String}+ , facetS :: Maybe Text} | ScopeSelected { scope :: Scope , blacklist :: Bool} | InfoElementSelected { mbInfo :: Maybe Descr} | PaneSelected {- paneN :: Maybe (String)}+ paneN :: Maybe (Text)} deriving (Eq, Ord, Show) data SensitivityMask =@@ -619,13 +613,13 @@ data CompletionWindow = CompletionWindow { cwWindow :: Window, cwTreeView :: TreeView,- cwListStore :: ListStore String}+ cwListStore :: ListStore Text} data StatusbarCompartment =- CompartmentCommand String+ CompartmentCommand Text | CompartmentPane (Maybe (IDEPane IDEM))- | CompartmentPackage String- | CompartmentState String+ | CompartmentPackage Text+ | CompartmentState Text | CompartmentOverlay Bool | CompartmentBufferPos (Int,Int) | CompartmentBuild Bool
src/IDE/Debug.hs view
@@ -82,28 +82,28 @@ import IDE.Workspaces (packageTry) import qualified Data.Conduit as C import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Util as CU import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..))-import Control.Applicative (Alternative(..))+import Control.Applicative (Alternative(..), (<$>), (<*>)) import Data.IORef (newIORef) import Data.Monoid ((<>), Monoid(..)) import Data.Text (Text)-import qualified Data.Text as T (isSuffixOf, unpack)+import qualified Data.Text as T+ (pack, lines, stripPrefix, unlines, isSuffixOf, unpack) import System.Exit (ExitCode(..)) import IDE.Pane.WebKit.Output (loadOutputUri) -- | Get the last item sinkLast = CL.fold (\_ a -> Just a) Nothing -debugCommand :: String -> C.Sink ToolOutput IDEM () -> DebugAction+debugCommand :: Text -> C.Sink ToolOutput IDEM () -> DebugAction debugCommand command handler = do debugCommand' command handler lift $ triggerEventIDE VariablesChanged return () -debugCommand' :: String -> C.Sink ToolOutput IDEM () -> DebugAction+debugCommand' :: Text -> C.Sink ToolOutput IDEM () -> DebugAction debugCommand' command handler = do ghci <- ask lift $ catchIDE (runDebug (executeDebugCommand command handler) ghci)@@ -133,12 +133,12 @@ -- > stripComments "-- > Wow this is meta" -- -- > stripComments "-- This is still a comment"-stripComments :: String -> String-stripComments t = maybe t unlines $- mapM (stripPrefix "-- >>>") lines'- <|> mapM (stripPrefix "-- >") lines'+stripComments :: Text -> Text+stripComments t = maybe t T.unlines $+ mapM (T.stripPrefix "-- >>>") lines'+ <|> mapM (T.stripPrefix "-- >") lines' where- lines' = lines t+ lines' = T.lines t debugExecuteSelection :: IDEAction debugExecuteSelection = do@@ -149,10 +149,12 @@ debugSetLiberalScope buffer <- liftIO $ newIORef mempty debugCommand (stripComments text) $ do- (_, _) <- CU.zipSinks sinkLast (logOutputPane text buffer)+ _ <- C.getZipSink $ const+ <$> C.ZipSink sinkLast+ <*> C.ZipSink (logOutputPane text buffer) mbURI <- lift $ readIDE autoURI case mbURI of- Just uri -> lift . postSyncIDE $ loadOutputUri uri+ Just uri -> lift . postSyncIDE . loadOutputUri $ T.unpack uri Nothing -> return () modifyIDE_ $ \ide -> ide {autoCommand = command, autoURI = Nothing} command@@ -165,8 +167,10 @@ Just text -> packageTry $ tryDebug $ do debugSetLiberalScope debugCommand (stripComments text) $ do- (out, _) <- CU.zipSinks (CL.fold buildOutputString "") logOutputDefault- lift . insertTextAfterSelection . T.unpack $ " " <> out+ out <- C.getZipSink $ const+ <$> C.ZipSink (CL.fold buildOutputString "")+ <*> C.ZipSink logOutputDefault+ lift . insertTextAfterSelection $ " " <> out Nothing -> ideMessage Normal "Please select some text in the editor to execute" where buildOutputString :: Text -> ToolOutput -> Text@@ -179,13 +183,13 @@ maybeModuleName <- lift selectedModuleName case maybeModuleName of Just moduleName ->- debugCommand (":module *" ++ moduleName) CL.sinkNull+ debugCommand (":module *" <> moduleName) CL.sinkNull Nothing -> do mbPackage <- lift getActivePackageDescr case mbPackage of Nothing -> return ()- Just p -> let packageNames = map (display . modu . mdModuleId) (pdModules p)- in debugCommand' (foldl (\a b -> a ++ " *" ++ b) ":module + " packageNames)+ Just p -> let packageNames = map (T.pack . display . modu . mdModuleId) (pdModules p)+ in debugCommand' (foldl (\a b -> a <> " *" <> b) ":module + " packageNames) CL.sinkNull debugAbandon :: IDEAction@@ -225,9 +229,9 @@ packageTry $ tryDebug $ debugCommand ":delete *" logOutputDefault setBreakpointList [] -debugDeleteBreakpoint :: String -> LogRef -> IDEAction+debugDeleteBreakpoint :: Text -> LogRef -> IDEAction debugDeleteBreakpoint indexString lr = do- packageTry $ tryDebug $ debugCommand (":delete " ++ indexString) logOutputDefault+ packageTry $ tryDebug $ debugCommand (":delete " <> indexString) logOutputDefault bl <- readIDE breakpointRefs setBreakpointList $ filter (/= lr) bl ideR <- ask@@ -237,7 +241,7 @@ debugForce = do maybeText <- selectedTextOrCurrentLine case maybeText of- Just text -> packageTry $ tryDebug $ debugCommand (":force " ++ stripComments text) logOutputDefault+ Just text -> packageTry $ tryDebug $ debugCommand (":force " <> stripComments text) logOutputDefault Nothing -> ideMessage Normal "Please select an expression in the editor" debugHistory :: IDEAction@@ -247,14 +251,14 @@ debugPrint = do maybeText <- selectedTextOrCurrentLine case maybeText of- Just text -> packageTry $ tryDebug $ debugCommand (":print " ++ stripComments text) logOutputDefault+ Just text -> packageTry $ tryDebug $ debugCommand (":print " <> stripComments text) logOutputDefault Nothing -> ideMessage Normal "Please select an name in the editor" debugSimplePrint :: IDEAction debugSimplePrint = do maybeText <- selectedTextOrCurrentLine case maybeText of- Just text -> packageTry $ tryDebug $ debugCommand (":force " ++ stripComments text) logOutputDefault+ Just text -> packageTry $ tryDebug $ debugCommand (":force " <> stripComments text) logOutputDefault Nothing -> ideMessage Normal "Please select an name in the editor" debugStep :: IDEAction@@ -270,11 +274,11 @@ debugSetLiberalScope debugStepExpr maybeText -debugStepExpr :: Maybe String -> DebugAction+debugStepExpr :: Maybe Text -> DebugAction debugStepExpr maybeText = do (debugPackage, _) <- ask case maybeText of- Just text -> debugCommand (":step " ++ stripComments text) (logOutputForHistoricContextDefault debugPackage)+ Just text -> debugCommand (":step " <> stripComments text) (logOutputForHistoricContextDefault debugPackage) Nothing -> lift $ ideMessage Normal "Please select an expression in the editor" debugStepLocal :: IDEAction@@ -305,11 +309,11 @@ debugSetLiberalScope debugTraceExpr maybeText -debugTraceExpr :: Maybe String -> DebugAction+debugTraceExpr :: Maybe Text -> DebugAction debugTraceExpr maybeText = do (debugPackage, _) <- ask case maybeText of- Just text -> debugCommand (":trace " ++ stripComments text) $ logTraceOutput debugPackage+ Just text -> debugCommand (":trace " <> stripComments text) $ logTraceOutput debugPackage Nothing -> lift $ ideMessage Normal "Please select an expression in the editor" @@ -351,7 +355,7 @@ case maybeText of Just text -> packageTry $ tryDebug $ do debugSetLiberalScope- debugCommand (":info "++stripComments text) logOutputDefault+ debugCommand (":info "<>stripComments text) logOutputDefault Nothing -> ideMessage Normal "Please select a name in the editor" debugKind :: IDEAction@@ -360,7 +364,7 @@ case maybeText of Just text -> packageTry $ tryDebug $ do debugSetLiberalScope- debugCommand (":kind "++stripComments text) logOutputDefault+ debugCommand (":kind "<>stripComments text) logOutputDefault Nothing -> ideMessage Normal "Please select a type in the editor" debugType :: IDEAction@@ -369,7 +373,7 @@ case maybeText of Just text -> packageTry $ tryDebug $ do debugSetLiberalScope- debugCommand (":type "++stripComments text) logOutputDefault+ debugCommand (":type "<>stripComments text) logOutputDefault Nothing -> ideMessage Normal "Please select an expression in the editor" debugSetBreakpoint :: IDEAction@@ -382,23 +386,23 @@ case maybeText of Just text -> packageTry $ tryDebug $ do (debugPackage, _) <- ask- debugCommand (":module *" ++ moduleName) logOutputDefault- debugCommand (":break " ++ text) (logOutputForSetBreakpointDefault debugPackage)+ debugCommand (":module *" <> moduleName) logOutputDefault+ debugCommand (":break " <> text) (logOutputForSetBreakpointDefault debugPackage) Nothing -> do maybeLocation <- selectedLocation case maybeLocation of Just (line, lineOffset) -> packageTry $ tryDebug $ do (debugPackage, _) <- ask- debugCommand (":break " ++ moduleName ++ " " ++ show (line + 1) ++ " " ++ show lineOffset)+ debugCommand (":break " <> moduleName <> " " <> T.pack (show $ line + 1) <> " " <> T.pack (show lineOffset)) (logOutputForSetBreakpointDefault debugPackage) Nothing -> ideMessage Normal "Unknown error setting breakpoint" ref <- ask return () Nothing -> ideMessage Normal "Please select module file in the editor" -debugSet :: (Bool -> String) -> Bool -> IDEAction+debugSet :: (Bool -> Text) -> Bool -> IDEAction debugSet flag value =- packageTry $ tryDebug $ debugCommand (":set " ++ flag value) logOutputDefault+ packageTry $ tryDebug $ debugCommand (":set " <> flag value) logOutputDefault debugSetPrintEvldWithShow :: Bool -> IDEAction debugSetPrintEvldWithShow = debugSet printEvldWithShowFlag
src/IDE/Find.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- --@@ -67,7 +69,7 @@ import Data.Char (digitToInt, isDigit, toLower, isAlphaNum) import Text.Regex.TDFA hiding (caseSensitive, after) import qualified Text.Regex.TDFA as Regex-import Text.Regex.TDFA.String (compile)+import Text.Regex.TDFA.Text (compile) import Data.List (find, isPrefixOf) import Data.Array (bounds, (!), inRange) import IDE.Pane.Grep (grepWorkspace)@@ -80,6 +82,10 @@ import Foreign.Ptr (Ptr(..)) import Foreign.ForeignPtr (withForeignPtr) import Graphics.UI.GtkInternals (unToolbar)+import Data.Text (Text)+import qualified Data.Text as T+ (pack, unpack, singleton, isPrefixOf, length, null, toLower)+import Data.Monoid ((<>)) foreign import ccall safe "gtk_toolbar_set_icon_size" gtk_toolbar_set_icon_size :: Ptr Toolbar -> CInt -> IO ()@@ -90,10 +96,10 @@ \selfPtr ->gtk_toolbar_set_icon_size selfPtr (fromIntegral $ fromEnum iconSize) data FindState = FindState {- entryStr :: String- , entryHist :: [String]- , replaceStr :: String- , replaceHist :: [String]+ entryStr :: Text+ , entryHist :: [Text]+ , replaceStr :: Text+ , replaceHist :: [Text] , caseSensitive :: Bool , entireWord :: Bool , wrapAround :: Bool@@ -203,13 +209,13 @@ spinTool <- toolItemNew spinL <- spinButtonNewWithRange 1.0 1000.0 10.0- widgetSetName spinL "gotoLineEntry"+ widgetSetName spinL ("gotoLineEntry" :: Text) containerAdd spinTool spinL- widgetSetName spinTool "gotoLineEntryTool"+ widgetSetName spinTool ("gotoLineEntryTool" :: Text) toolbarInsert toolbar spinTool 0 labelTool3 <- toolItemNew- label3 <- labelNew (Just "Goto Line :")+ label3 <- labelNew (Just (__"Goto Line :")) containerAdd labelTool3 label3 toolbarInsert toolbar labelTool3 0 @@ -217,15 +223,15 @@ toolbarInsert toolbar sep1 0 let performGrep = reflectIDE (packageTry $ doGrep toolbar) ideR- grepButton <- toolButtonNew (Nothing :: Maybe Widget) (Just "Grep")+ grepButton <- toolButtonNew (Nothing :: Maybe Widget) (Just (__"Grep")) toolbarInsert toolbar grepButton 0 grepButton `onToolButtonClicked` performGrep- set grepButton [widgetTooltipText := Just "Search in multiple files"]+ set grepButton [widgetTooltipText := Just (__"Search in multiple files")] sep1 <- separatorToolItemNew toolbarInsert toolbar sep1 0 - replaceAllButton <- toolButtonNew (Nothing :: Maybe Widget) (Just "Replace All")+ replaceAllButton <- toolButtonNew (Nothing :: Maybe Widget) (Just (__"Replace All")) toolbarInsert toolbar replaceAllButton 0 replaceButton <- toolButtonNewFromStock "gtk-find-and-replace"@@ -233,13 +239,13 @@ replaceTool <- toolItemNew rentry <- entryNew- widgetSetName rentry "replaceEntry"+ widgetSetName rentry ("replaceEntry" :: Text) containerAdd replaceTool rentry- widgetSetName replaceTool "replaceTool"+ widgetSetName replaceTool ("replaceTool" :: Text) toolbarInsert toolbar replaceTool 0 labelTool2 <- toolItemNew- label2 <- labelNew (Just "Replace: ")+ label2 <- labelNew (Just (__"Replace: ")) containerAdd labelTool2 label2 toolbarInsert toolbar labelTool2 0 @@ -248,30 +254,31 @@ nextButton <- toolButtonNewFromStock "gtk-go-forward" toolbarInsert toolbar nextButton 0- set nextButton [widgetTooltipText := Just "Search for the next match in the current file"]+ set nextButton [widgetTooltipText := Just (__"Search for the next match in the current file")] nextButton `onToolButtonClicked` doSearch toolbar Forward ideR wrapAroundButton <- toggleToolButtonNew- toolButtonSetLabel wrapAroundButton (Just "Wrap")- widgetSetName wrapAroundButton "wrapAroundButton"+ toolButtonSetLabel wrapAroundButton (Just (__"Wrap"))+ widgetSetName wrapAroundButton ("wrapAroundButton" :: Text) toolbarInsert toolbar wrapAroundButton 0- set wrapAroundButton [widgetTooltipText := Just "When selected searching will continue from the top when no more matches are found"]+ set wrapAroundButton [widgetTooltipText := Just (__"When selected searching will continue from the top when no more matches are found")] previousButton <- toolButtonNewFromStock "gtk-go-back" toolbarInsert toolbar previousButton 0- set previousButton [widgetTooltipText := Just "Search for the previous match in the current file"]+ set previousButton [widgetTooltipText := Just (__"Search for the previous match in the current file")] previousButton `onToolButtonClicked` doSearch toolbar Backward ideR entryTool <- toolItemNew entry <- entryNew- widgetSetName entry "searchEntry"+ widgetSetName entry ("searchEntry" :: Text) containerAdd entryTool entry- widgetSetName entryTool "searchEntryTool"+ widgetSetName entryTool ("searchEntryTool" :: Text) toolItemSetExpand entryTool True toolbarInsert toolbar entryTool 0 + let column0 = makeColumnIdString 0 store <- listStoreNew []- customStoreSetColumn store (makeColumnIdString 0) id+ customStoreSetColumn store column0 id completion <- entryCompletionNew entrySetCompletion entry completion@@ -283,39 +290,39 @@ (\ cd -> [cellText := cd]) entryCompletionSetMatchFunc completion (matchFunc store) on completion matchSelected $ \ model iter -> do- txt <- treeModelGetValue model iter (makeColumnIdString 0)+ txt <- treeModelGetValue model iter column0 entrySetText entry txt doSearch toolbar Forward ideR return True regexButton <- toggleToolButtonNew- toolButtonSetLabel regexButton (Just "Regex")- widgetSetName regexButton "regexButton"+ toolButtonSetLabel regexButton (Just (__"Regex"))+ widgetSetName regexButton ("regexButton" :: Text) toolbarInsert toolbar regexButton 0 regexButton `onToolButtonClicked` doSearch toolbar Insert ideR- set regexButton [widgetTooltipText := Just "When selected the search string is used as a regular expression"]+ set regexButton [widgetTooltipText := Just (__"When selected the search string is used as a regular expression")] entireWordButton <- toggleToolButtonNew- toolButtonSetLabel entireWordButton (Just "Words")- widgetSetName entireWordButton "entireWordButton"+ toolButtonSetLabel entireWordButton (Just (__"Words"))+ widgetSetName entireWordButton ("entireWordButton" :: Text) toolbarInsert toolbar entireWordButton 0 entireWordButton `onToolButtonClicked` doSearch toolbar Insert ideR- set entireWordButton [widgetTooltipText := Just "When selected only entire words are matched"]+ set entireWordButton [widgetTooltipText := Just (__"When selected only entire words are matched")] caseSensitiveButton <- toggleToolButtonNew- toolButtonSetLabel caseSensitiveButton (Just "Case")- widgetSetName caseSensitiveButton "caseSensitiveButton"+ toolButtonSetLabel caseSensitiveButton (Just (__"Case"))+ widgetSetName caseSensitiveButton ("caseSensitiveButton" :: Text) toolbarInsert toolbar caseSensitiveButton 0 caseSensitiveButton `onToolButtonClicked` doSearch toolbar Insert ideR- set caseSensitiveButton [widgetTooltipText := Just "When selected the search is case sensitive"]+ set caseSensitiveButton [widgetTooltipText := Just (__"When selected the search is case sensitive")] labelTool <- toolItemNew- label <- labelNew (Just "Find: ")+ label <- labelNew (Just (__"Find: ")) containerAdd labelTool label toolbarInsert toolbar labelTool 0 - after entry insertText (\ t i -> do+ after entry insertText (\ (t::Text) i -> do doSearch toolbar Insert ideR return i) after entry deleteText (\ _ _ -> doSearch toolbar Delete ideR)@@ -352,7 +359,7 @@ widgetGrabFocus re --- widgetAc return True- _ | mapControlCommand Control `elem` mods -> liftIO . ctrl $ map toLower name+ _ | mapControlCommand Control `elem` mods -> liftIO . ctrl $ T.toLower name _ -> return False rentry `on` keyPressEvent $ do@@ -364,7 +371,7 @@ widgetGrabFocus fe return True | mapControlCommand Control `elem` mods ->- liftIO . ctrl $ map toLower name+ liftIO . ctrl $ T.toLower name | otherwise -> return False after spinL focusInEvent . liftIO $ reflectIDE (inActiveBufContext True $ \ _ _ ebuf _ _ -> do@@ -381,7 +388,7 @@ re <- getFindEntry toolbar widgetGrabFocus re return True- _ | mapControlCommand Control `elem` mods -> liftIO . ctrl $ map toLower name+ _ | mapControlCommand Control `elem` mods -> liftIO . ctrl $ T.toLower name _ -> return False after spinL entryActivate $ reflectIDE (inActiveBufContext () $ \ _ sv ebuf _ _ -> do@@ -424,7 +431,7 @@ case mbExpAndMatchIndex of Just (exp, matchIndex) -> do res <- reflectIDE (editFind entireWord caseSensitive wrapAround regex search "" hint) ideR- if res || null search+ if res || T.null search then do widgetModifyBase entry StateNormal white widgetModifyText entry StateNormal black@@ -432,7 +439,7 @@ widgetModifyBase entry StateNormal red widgetModifyText entry StateNormal white Nothing ->- if null search+ if T.null search then do widgetModifyBase entry StateNormal white widgetModifyText entry StateNormal black@@ -455,24 +462,24 @@ let (regexString, _) = regexStringAndMatchIndex entireWord regex search liftIDE $ workspaceTry $ grepWorkspace regexString caseSensitive -matchFunc :: ListStore String -> String -> TreeIter -> IO Bool+matchFunc :: ListStore Text -> Text -> TreeIter -> IO Bool matchFunc model str iter = do tp <- treeModelGetPath model iter case tp of (i:_) -> do row <- listStoreGetValue model i- return (isPrefixOf (map toLower str) (map toLower row) && length str < length row)+ return (T.isPrefixOf (T.toLower str) (T.toLower row) && T.length str < T.length row) otherwise -> return False -addToHist :: String -> IDEAction+addToHist :: Text -> IDEAction addToHist str =- unless (null str) $+ unless (T.null str) $ do (_, ls) <- needFindbar liftIO $ do entryHist <- listStoreToList ls- unless (any (str `isPrefixOf`) entryHist) $+ unless (any (str `T.isPrefixOf`) entryHist) $ do let newList = take 12- (str : filter (\ e -> not (e `isPrefixOf` str)) entryHist)+ (str : filter (\ e -> not (e `T.isPrefixOf` str)) entryHist) listStoreClear ls mapM_ (listStoreAppend ls) newList @@ -505,14 +512,14 @@ ideR return () -editFind :: Bool -> Bool -> Bool -> Bool -> String -> String -> SearchHint -> IDEM Bool+editFind :: Bool -> Bool -> Bool -> Bool -> Text -> Text -> SearchHint -> IDEM Bool editFind entireWord caseSensitive wrapAround regex search dummy hint = do mbExpAndMatchIndex <- liftIO $ regexAndMatchIndex caseSensitive entireWord regex search case mbExpAndMatchIndex of Nothing -> return False Just (exp, matchIndex) -> editFind' exp matchIndex wrapAround dummy hint -editFind' :: Regex -> Int -> Bool -> String -> SearchHint -> IDEM Bool+editFind' :: Regex -> Int -> Bool -> Text -> SearchHint -> IDEM Bool editFind' exp matchIndex wrapAround dummy hint = inActiveBufContext False $ \_ sv ebuf _ _ -> do i1 <- getStartIter ebuf@@ -561,30 +568,30 @@ offset <- getOffset iter findMatch exp matchIndex ebuf text (>= offset) False -regexAndMatchIndex :: Bool -> Bool -> Bool -> String -> IO (Maybe (Regex, Int))+regexAndMatchIndex :: Bool -> Bool -> Bool -> Text -> IO (Maybe (Regex, Int)) regexAndMatchIndex caseSensitive entireWord regex string =- if null string+ if T.null string then return Nothing else do let (regexString, index) = regexStringAndMatchIndex entireWord regex string case compileRegex caseSensitive regexString of Left err -> do- sysMessage Normal err+ sysMessage Normal $ T.pack err return Nothing Right regex -> return $ Just (regex, index) -regexStringAndMatchIndex :: Bool -> Bool -> String -> (String, Int)+regexStringAndMatchIndex :: Bool -> Bool -> Text -> (Text, Int) regexStringAndMatchIndex entireWord regex string = -- Escape non regex string let regexString = if regex then string- else foldl (\s c -> s ++ if isAlphaNum c then [c] else ['\\', c]) "" string in+ else foldl (\s c -> s <> if isAlphaNum c then T.singleton c else "\\"<>T.singleton c) "" $ T.unpack string in -- Regular expression with word filter if needed if entireWord- then ("(^|[^a-zA-Z0-9])(" ++ regexString ++ ")($|[^a-zA-Z0-9])", 2)+ then ("(^|[^a-zA-Z0-9])(" <> regexString <> ")($|[^a-zA-Z0-9])", 2) else (regexString, 0) -findMatch :: TextEditor editor => Regex -> Int -> EditorBuffer editor -> String -> (Int -> Bool) -> Bool -> IDEM (Maybe (EditorIter editor, EditorIter editor, MatchArray))+findMatch :: TextEditor editor => Regex -> Int -> EditorBuffer editor -> Text -> (Int -> Bool) -> Bool -> IDEM (Maybe (EditorIter editor, EditorIter editor, MatchArray)) findMatch exp matchIndex gtkbuf text offsetPred findLast = do let matches = (if findLast then reverse else id) (matchAll exp text) case find (offsetPred . fst . (!matchIndex)) matches of@@ -595,11 +602,11 @@ return $ Just (iter1, iter2, matches) Nothing -> return Nothing -editReplace :: Bool -> Bool -> Bool -> Bool -> String -> String -> SearchHint -> IDEM Bool+editReplace :: Bool -> Bool -> Bool -> Bool -> Text -> Text -> SearchHint -> IDEM Bool editReplace entireWord caseSensitive wrapAround regex search replace hint = editReplace' entireWord caseSensitive wrapAround regex search replace hint True -editReplace' :: Bool -> Bool -> Bool -> Bool -> String -> String -> SearchHint -> Bool -> IDEM Bool+editReplace' :: Bool -> Bool -> Bool -> Bool -> Text -> Text -> SearchHint -> Bool -> IDEM Bool editReplace' entireWord caseSensitive wrapAround regex search replace hint mayRepeat = inActiveBufContext False $ \_ _ ebuf _ _ -> do insertMark <- getInsertMark ebuf@@ -614,11 +621,11 @@ match <- findMatch exp matchIndex ebuf text (== offset) False case match of Just (iterStart, iterEnd, matches) -> do- mbText <- liftIO $ replacementText regex text matchIndex matches replace+ mbText <- liftIO $ replacementText regex text matchIndex matches $ T.unpack replace case mbText of Just text -> do delete ebuf iterStart iterEnd- insert ebuf iterStart text+ insert ebuf iterStart (T.pack text) Nothing -> do sysMessage Normal "Should never happen. findMatch worked but repleacementText failed"@@ -636,11 +643,11 @@ replacementText True text matchIndex matches replace = case compileRegex caseSensitive search of Left err -> do- sysMessage Normal err+ sysMessage Normal $ T.pack err return Nothing Right exp -> return $ Just $ regexReplacement text matchIndex matches replace -regexReplacement :: String -> Int -> MatchArray -> String -> String+regexReplacement :: Text -> Int -> MatchArray -> String -> String regexReplacement _ _ _ [] = [] regexReplacement text matchIndex matches ('\\' : '\\' : xs) = '\\' : regexReplacement text matchIndex matches xs regexReplacement text matchIndex matches ('\\' : n : xs) | isDigit n =@@ -648,20 +655,20 @@ value = if inRange (bounds matches) subIndex then let subExp = matches!(matchIndex + digitToInt n) in- take (snd subExp) $ drop (fst subExp) text+ take (snd subExp) $ drop (fst subExp) $ T.unpack text else ['\\', n] in value ++ regexReplacement text matchIndex matches xs regexReplacement text matchIndex matches (x : xs) = x : regexReplacement text matchIndex matches xs -editReplaceAll :: Bool -> Bool -> Bool -> Bool -> String -> String -> SearchHint -> IDEM Bool+editReplaceAll :: Bool -> Bool -> Bool -> Bool -> Text -> Text -> SearchHint -> IDEM Bool editReplaceAll entireWord caseSensitive wrapAround regex search replace hint = do res <- editReplace' entireWord caseSensitive False regex search replace hint True if res then editReplaceAll entireWord caseSensitive False regex search replace hint else return False -compileRegex :: Bool -> String -> Either String Regex+compileRegex :: Bool -> Text -> Either String Regex compileRegex caseSense searchString = let compOption = defaultCompOpt { Regex.caseSensitive = caseSense@@ -673,7 +680,7 @@ white = Color 64000 64000 64000 black = Color 0 0 0 -needFindbar :: IDEM (Toolbar,ListStore String)+needFindbar :: IDEM (Toolbar,ListStore Text) needFindbar = do (_,mbfb) <- readIDE findbar case mbfb of@@ -715,7 +722,7 @@ getReplaceEntry = getWidget "replaceTool" getFindEntry = getWidget "searchEntryTool" -getWidget :: String -> Toolbar -> IO Widget+getWidget :: Text -> Toolbar -> IO Widget getWidget str tb = do widgets <- containerGetChildren tb entryL <- filterM (liftM (== str) . widgetGetName) widgets@@ -733,7 +740,7 @@ getCaseSensitive = getSelection "caseSensitiveButton" getRegex = getSelection "regexButton" -getSelection :: String -> Toolbar -> IO Bool+getSelection :: Text -> Toolbar -> IO Bool getSelection str tb = do widgets <- containerGetChildren tb entryL <- filterM (liftM (== str) . widgetGetName) widgets@@ -747,7 +754,7 @@ setCaseSensitive = setSelection "caseSensitiveButton" setRegex = setSelection "regexButton" -setSelection :: String -> Toolbar -> Bool -> IO ()+setSelection :: Text -> Toolbar -> Bool -> IO () setSelection str tb bool = do widgets <- containerGetChildren tb entryL <- filterM (liftM (== str) . widgetGetName ) widgets
src/IDE/ImportTool.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.ImportTool@@ -29,6 +30,7 @@ import Distribution.Text (simpleParse, display, disp) import IDE.Pane.SourceBuffer import Graphics.UI.Gtk+import IDE.Utils.GUIUtils import Text.ParserCombinators.Parsec.Language (haskellStyle) import Graphics.UI.Editor.MakeEditor (getRealWidget, FieldDescription(..), buildEditor, mkField)@@ -66,11 +68,15 @@ import Control.Monad.IO.Class (MonadIO(..)) import Distribution.PackageDescription.PrettyPrint (writeGenericPackageDescription)-import qualified Data.Text as T (unpack)+import qualified Data.Text as T+ (takeWhile, stripPrefix, lines, dropWhile, empty, length, take,+ pack, unpack) import Language.Haskell.Exts (KnownExtension)+import Data.Text (Text)+import Data.Monoid ((<>)) -readMaybe :: Read a => String -> Maybe a-readMaybe s = case reads s of+readMaybe :: Read a => Text -> Maybe a+readMaybe s = case reads $ T.unpack s of [(x, "")] -> Just x _ -> Nothing @@ -85,11 +91,11 @@ addPackageResults <- forM errors addPackage let notInScopes = [ y | (x,y) <- nubBy (\ (p1,_) (p2,_) -> p1 == p2)- $ [(x,y) | (x,y) <- [((parseNotInScope . T.unpack . refDescription) e, e) | e <- errors]],+ $ [(x,y) | (x,y) <- [((parseNotInScope . refDescription) e, e) | e <- errors]], isJust x] let extensions = [ y | (x,y) <- nubBy (\ (p1,_) (p2,_) -> p1 == p2)- $ [(x,y) | (x,y) <- [((parsePerhapsYouIntendedToUse . T.unpack . refDescription) e, e) | e <- errors]],+ $ [(x,y) | (x,y) <- [((parsePerhapsYouIntendedToUse . refDescription) e, e) | e <- errors]], length x == 1] when (not (or addPackageResults) && null notInScopes && null extensions) $ ideMessage Normal $ "No errors that can be auto resolved" addAll buildInBackground notInScopes extensions@@ -125,7 +131,7 @@ -- be used for default selection addImport :: LogRef -> [Descr] -> ((Bool,[Descr]) -> IDEAction) -> IDEAction addImport error descrList continuation =- case parseNotInScope . T.unpack $ refDescription error of+ case parseNotInScope $ refDescription error of Nothing -> continuation (True,descrList) Just nis -> do currentInfo' <- getScopeForActiveBuffer@@ -139,7 +145,7 @@ wslist = getIdentifierDescr (id' nis) symbolTable3 symbolTable4 in case (list, wslist) of ([], []) -> do- ideMessage Normal $ "Identifier " ++ (id' nis) ++ " not found"+ ideMessage Normal $ "Identifier " <> (id' nis) <> " not found" continuation (True, descrList) ([], list) -> do window' <- getMainWindow@@ -170,12 +176,12 @@ addPackage :: LogRef -> IDEM Bool addPackage error = do- case parseHiddenModule . T.unpack $ refDescription error of+ case parseHiddenModule $ refDescription error of Nothing -> return False Just (HiddenModuleResult mod pack) -> do let idePackage = logRefPackage error gpd <- liftIO $ readPackageDescription normal (ipdCabalFile $ idePackage)- ideMessage Normal $ "addPackage " ++ (display $ pkgName pack)+ ideMessage Normal $ "addPackage " <> (T.pack . display $ pkgName pack) liftIO $ writeGenericPackageDescription (ipdCabalFile $ idePackage) gpd { condLibrary = addDepToLib pack (condLibrary gpd), condExecutables = map (addDepToExe pack)@@ -218,13 +224,13 @@ case (mbBuf,mbMod) of (Just buf,Just mod) -> do inActiveBufContext () $ \ nb _ gtkbuf idebuf n -> do- ideMessage Normal $ "addImport " ++ show (dscName descr) ++ " from "- ++ (render $ disp $ mod)+ ideMessage Normal $ "addImport " <> T.pack (show $ dscName descr) <> " from "+ <> T.pack (render $ disp mod) doServerCommand (ParseHeaderCommand filePath) $ \ res -> case res of ServerHeader (Left imports) -> case filter (qualifyAsImportStatement mod) imports of- [] -> let newLine = prettyPrint (newImpDecl mod) ++ "\n"+ [] -> let newLine = prettyPrint (newImpDecl mod) <> "\n" lastLine = foldr max 0 (map (locationELine . importLoc) imports) in do i1 <- getIterAtLine gtkbuf lastLine@@ -234,7 +240,7 @@ continuation (True,(descr : descrList)) l@(impDecl:_) -> let newDecl = addToDecl impDecl- newLine = prettyPrint newDecl ++ "\n"+ newLine = prettyPrint newDecl <> "\n" myLoc = importLoc impDecl lineStart = locationSLine myLoc lineEnd = locationELine myLoc@@ -247,7 +253,7 @@ setModified gtkbuf True continuation (True,(descr : descrList)) ServerHeader (Right lastLine) ->- let newLine = prettyPrint (newImpDecl mod) ++ "\n"+ let newLine = prettyPrint (newImpDecl mod) <> "\n" in do i1 <- getIterAtLine gtkbuf lastLine editInsertCode gtkbuf i1 newLine@@ -255,8 +261,8 @@ setModified gtkbuf True continuation (True,(descr : descrList)) ServerFailed string -> do- ideMessage Normal ("Can't parse module header " ++ filePath ++- " failed with: " ++ string)+ ideMessage Normal ("Can't parse module header " <> T.pack filePath <>+ " failed with: " <> string) continuation (False,[]) _ -> do ideMessage Normal ("ImportTool>>addImport: Impossible server answer")@@ -267,7 +273,7 @@ qualifyAsImportStatement moduleName impDecl = let importName = importModule impDecl getHiding (ImportSpecList isHiding _) = isHiding- in importName == display moduleName+ in importName == T.pack (display moduleName) && ((isNothing (mbQual' nis) && not (importQualified impDecl)) || (isJust (mbQual' nis) && importQualified impDecl && fromJust (mbQual' nis) == qualString impDecl))@@ -275,7 +281,7 @@ newImpDecl :: D.ModuleName -> ImportDecl newImpDecl mod = ImportDecl { importLoc = noLocation,- importModule = display mod,+ importModule = T.pack $ display mod, importQualified = isJust (mbQual' nis), importSrc = False, importPkg = Nothing,@@ -292,7 +298,7 @@ impDecl{importSpecs = Just (ImportSpecList False (nub (newImportSpec : listIE)))} Nothing -> impDecl{importSpecs = Just (ImportSpecList False [newImportSpec])}- noLocation = Location 0 0 0 0+ noLocation = Location "" 0 0 0 0 getRealId descr id = case descr of Reexported rdescr -> getRealId (dsrDescr rdescr) id@@ -303,7 +309,7 @@ getReal (MethodDescr d) = IThingAll (dscName d) getReal _ = IVar id -qualString :: ImportDecl -> String+qualString :: ImportDecl -> Text qualString impDecl = case importAs impDecl of Nothing -> "" Just modName -> modName@@ -311,8 +317,8 @@ -- | The import data data NotInScopeParseResult = NotInScopeParseResult {- mbQual' :: Maybe String- , id' :: String+ mbQual' :: Maybe Text+ , id' :: Text , isSub' :: Bool , isOp' :: Bool} deriving Eq@@ -321,15 +327,15 @@ lexer = P.makeTokenParser haskellStyle whiteSpace = P.whiteSpace lexer-lexeme = P.lexeme lexer+lexeme = (T.pack <$>) . P.lexeme lexer symbol = P.symbol lexer-identifier = P.identifier lexer+identifier = T.pack <$> P.identifier lexer dot = P.dot lexer-operator = P.operator lexer+operator = T.pack <$> P.operator lexer -parseNotInScope :: String -> (Maybe NotInScopeParseResult)+parseNotInScope :: Text -> (Maybe NotInScopeParseResult) parseNotInScope str =- case Parsec.parse scopeParser "" str of+ case Parsec.parse scopeParser "" $ T.unpack str of Left e -> Nothing Right r -> Just r @@ -348,7 +354,7 @@ id <- optionMaybe (try identifier) case id of Just id -> return (NotInScopeParseResult mbQual- (take (length id - 1) id) (isJust isSub) False)+ (T.take (T.length id - 1) id) (isJust isSub) False) Nothing -> do op <- operator char '\''@@ -379,10 +385,10 @@ -- |* The little dialog to choose between possible modules -moduleFields :: [String] -> String -> FieldDescription String+moduleFields :: [Text] -> Text -> FieldDescription Text moduleFields list ident = mkField- (paraName <<<- ParaName ("From which module is " ++ ident)+ (paraName <<<- ParaName ("From which module is " <> ident) $ paraMultiSel <<<- ParaMultiSel False $ paraMinSize <<<- ParaMinSize (300,400) $ emptyParams)@@ -390,9 +396,9 @@ (\ a b -> a) (staticListEditor ( list) id) -selectModuleDialog :: Window -> [Descr] -> String -> Maybe String -> Maybe Descr -> IO (Maybe Descr)+selectModuleDialog :: Window -> [Descr] -> Text -> Maybe Text -> Maybe Descr -> IO (Maybe Descr) selectModuleDialog parentWindow list id mbQual mbDescr =- let selectionList = (nub . sort) $ map (render . disp . modu . fromJust . dsMbModu) list+ let selectionList = (nub . sort) $ map (T.pack . render . disp . modu . fromJust . dsMbModu) list in if length selectionList == 1 then return (Just (head list)) else do@@ -400,7 +406,7 @@ Nothing -> Nothing Just descr -> case dsMbModu descr of Nothing -> Nothing- Just pm -> Just ((render . disp . modu) pm)+ Just pm -> Just ((T.pack . render . disp . modu) pm) let realSelectionString = case mbSelectedString of Nothing -> head selectionList Just str -> if elem str selectionList@@ -408,7 +414,7 @@ else head selectionList let qualId = case mbQual of Nothing -> id- Just str -> str ++ "." ++ id+ Just str -> str <> "." <> id dia <- dialogNew set dia [ windowTransientFor := parentWindow ] #ifdef MIN_VERSION_gtk3@@ -416,8 +422,8 @@ #else upper <- dialogGetUpper dia #endif- okButton <- dialogAddButton dia "Ok" ResponseOk- dialogAddButton dia "Cancel" ResponseCancel+ okButton <- dialogAddButton dia (__"Add Import") ResponseOk+ dialogAddButton dia (__"Cancel") ResponseCancel (widget,inj,ext,_) <- buildEditor (moduleFields selectionList qualId) realSelectionString boxPackStart (castToBox upper) widget PackGrow 7 dialogSetDefaultResponse dia ResponseOk --does not work for the tree view@@ -426,7 +432,7 @@ set okButton [widgetCanDefault := True] widgetGrabDefault okButton resp <- dialogRun dia- value <- ext ([])+ value <- ext (T.empty) widgetHide dia widgetDestroy dia --find@@ -434,35 +440,35 @@ (ResponseOk,Just v) -> return (Just (head (filter (\e -> case dsMbModu e of Nothing -> False- Just pm -> (render . disp . modu) pm == v) list)))+ Just pm -> (T.pack . render . disp . modu) pm == v) list))) _ -> return Nothing data HiddenModuleResult = HiddenModuleResult {- hiddenModule :: String+ hiddenModule :: Text , missingPackage :: PackageId} deriving (Eq, Show) -parseHiddenModule :: String -> (Maybe HiddenModuleResult)+parseHiddenModule :: Text -> (Maybe HiddenModuleResult) parseHiddenModule str =- case Parsec.parse hiddenModuleParser "" str of+ case Parsec.parse hiddenModuleParser "" $ T.unpack str of Left e -> Nothing Right (mod, pack) ->- case simpleParse pack of+ case simpleParse $ T.unpack pack of Just p -> Just $ HiddenModuleResult mod p Nothing -> Nothing -hiddenModuleParser :: CharParser () (String, String)+hiddenModuleParser :: CharParser () (Text, Text) hiddenModuleParser = do whiteSpace symbol "Could not find module " (char '`' <|> char '‛' <|> char '‘')- mod <- many (noneOf "'’")+ mod <- T.pack <$> many (noneOf "'’") many (noneOf "\n") symbol "\n" whiteSpace symbol "It is a member of the hidden package " (char '`' <|> char '‛' <|> char '‘')- pack <- many (noneOf "'’")+ pack <- T.pack <$> many (noneOf "'’") (char '\'' <|> char '’') symbol ".\n" many anyChar@@ -477,50 +483,50 @@ -- > parsePerhapsExt "Error blah blah\n Perhaps you intended to use ScopedTypeVariables\n\n" -- -- > parsePerhapsExt "Error blah blah\n Use -XNoBugsExt\n\n"-parsePerhapsYouIntendedToUse :: String -> [KnownExtension]+parsePerhapsYouIntendedToUse :: Text -> [KnownExtension] parsePerhapsYouIntendedToUse =- concatMap (parseLine . dropWhile (==' ')) . lines+ concatMap (parseLine . T.dropWhile (==' ')) . T.lines where- parseLine :: String -> [KnownExtension]+ parseLine :: Text -> [KnownExtension] parseLine line = take 1 . catMaybes . map readMaybe $ catMaybes [- stripPrefix "Perhaps you intended to use -X" line- , stripPrefix "Perhaps you intended to use " line- , takeWhile (/=' ') <$> stripPrefix "Use -X" line- , takeWhile (/=' ') <$> stripPrefix "Use " line- , takeWhile (/=' ') <$> stripPrefix "(Use -X" line- , takeWhile (/=' ') <$> stripPrefix "(Use " line- , takeWhile (/=' ') <$> stripPrefix "You need -X" line- , takeWhile (/=' ') <$> stripPrefix "You need " line]+ T.stripPrefix "Perhaps you intended to use -X" line+ , T.stripPrefix "Perhaps you intended to use " line+ , T.takeWhile (/=' ') <$> T.stripPrefix "Use -X" line+ , T.takeWhile (/=' ') <$> T.stripPrefix "Use " line+ , T.takeWhile (/=' ') <$> T.stripPrefix "(Use -X" line+ , T.takeWhile (/=' ') <$> T.stripPrefix "(Use " line+ , T.takeWhile (/=' ') <$> T.stripPrefix "You need -X" line+ , T.takeWhile (/=' ') <$> T.stripPrefix "You need " line] addExtension :: LogRef -> (Bool -> IDEAction) -> IDEAction addExtension error continuation =- case parsePerhapsYouIntendedToUse . T.unpack $ refDescription error of+ case parsePerhapsYouIntendedToUse $ refDescription error of [] -> continuation True- [ext] -> addExtension' (show ext) (logRefFullFilePath error) continuation+ [ext] -> addExtension' (T.pack $ show ext) (logRefFullFilePath error) continuation list -> continuation True -addExtension' :: String -> FilePath -> (Bool -> IDEAction) -> IDEAction+addExtension' :: Text -> FilePath -> (Bool -> IDEAction) -> IDEAction addExtension' ext filePath continuation = do mbBuf <- selectSourceBuf filePath case mbBuf of Just buf -> inActiveBufContext () $ \ nb _ gtkbuf idebuf n -> do- ideMessage Normal $ "addExtension " ++ ext+ ideMessage Normal $ "addExtension " <> ext i1 <- getIterAtLine gtkbuf 0- editInsertCode gtkbuf i1 $ "{-# LANGUAGE " ++ ext ++ " #-}\n"+ editInsertCode gtkbuf i1 $ "{-# LANGUAGE " <> ext <> " #-}\n" fileSave False setModified gtkbuf True continuation True _ -> return () addResolveMenuItems ideR theMenu logRef = do- let msg = T.unpack $ refDescription logRef+ let msg = refDescription logRef when (isJust $ parseNotInScope msg) $- addFixMenuItem "Add Import" $ addImport logRef [] (\ _ -> return ())+ addFixMenuItem (__"Add Import") $ addImport logRef [] (\ _ -> return ()) when (isJust $ parseHiddenModule msg) $- addFixMenuItem "Add Package" $ addPackage logRef+ addFixMenuItem (__"Add Package") $ addPackage logRef when ((length $ parsePerhapsYouIntendedToUse msg) == 1) $- addFixMenuItem "Add Extension" $ addExtension logRef (\ _ -> return ())+ addFixMenuItem (__"Add Extension") $ addExtension logRef (\ _ -> return ()) where addFixMenuItem name fix = do item <- menuItemNewWithLabel name
src/IDE/Keymap.hs view
@@ -19,6 +19,9 @@ import IDE.Core.State import Control.Monad (foldM) import System.Log.Logger (infoM)+import Data.Text (Text)+import qualified Data.Text as T (toLower, unpack, pack)+import Control.Applicative ((<$>)) class Keymap alpha where parseKeymap :: FilePath -> IO alpha@@ -40,7 +43,7 @@ infoM "leksah" $ "Reading keymap from " ++ fn res <- parseFromFile keymapParser fn case res of- Left pe -> throwIDE $"Error reading keymap file " ++ show fn ++ " " ++ show pe+ Left pe -> throwIDE . T.pack $ "Error reading keymap file " ++ show fn ++ " " ++ show pe Right r -> return r --@@ -94,10 +97,10 @@ } lexer = P.makeTokenParser keymapStyle lexeme = P.lexeme lexer-identifier = P.identifier lexer+identifier = T.pack <$> P.identifier lexer symbol = P.symbol lexer whiteSpace = P.whiteSpace lexer-stringLiteral = P.stringLiteral lexer+stringLiteral = T.pack <$> P.stringLiteral lexer keymapParser :: CharParser () KeymapI keymapParser = do@@ -107,7 +110,7 @@ return (KM (Map.fromListWith (++) ls)) lineparser :: CharParser () (ActionString, [(Maybe (Either KeyString- (KeyString,KeyString)), Maybe String)])+ (KeyString,KeyString)), Maybe Text)]) lineparser = do mb1 <- option Nothing (do keyDescr <- identifier@@ -132,12 +135,12 @@ -------------------------------------------------- -- Have to write this until gtk_accelerator_parse gets bound in gtk2hs ---accParse :: String -> IO (KeyVal,[Modifier])-accParse str = case parse accparser "accelerator" str of+accParse :: Text -> IO (KeyVal,[Modifier])+accParse str = case parse accparser "accelerator" (T.unpack str) of Right (ks,mods) -> do- key <- keyvalFromName (map toLower ks)+ key <- keyvalFromName $ T.toLower ks return (key,sort mods)- Left e -> throwIDE $show e+ Left e -> throwIDE . T.pack $ show e accStyle :: P.LanguageDef st accStyle= emptyDef{P.caseSensitive = False}@@ -145,15 +148,15 @@ lexer2 = P.makeTokenParser accStyle lexeme2 = P.lexeme lexer2 symbol2 = P.symbol lexer2-identifier2 = P.identifier lexer2+identifier2 = T.pack <$> P.identifier lexer2 whiteSpace2 = P.whiteSpace lexer2 -accparser :: GenParser Char () (String,[Modifier])+accparser :: GenParser Char () (Text,[Modifier]) accparser = do whiteSpace2 mods <- many modparser key <- identifier2- return (key,mods)+ return (key, mods) modparser :: GenParser Char () Modifier modparser = do
src/IDE/Leksah.hs view
@@ -52,7 +52,7 @@ import IDE.Find import Graphics.UI.Editor.Composite (filesEditor, maybeEditor) import Graphics.UI.Editor.Simple- (enumEditor, stringEditor)+ (stringEditor, enumEditor, textEditor) import IDE.Metainfo.Provider (initInfo) import IDE.Workspaces (workspaceAddPackage', workspaceTryQuiet, workspaceNewHere,@@ -78,13 +78,15 @@ import Control.Monad (when, unless, liftM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Applicative ((<$>))-import qualified Data.Text as T (unpack, stripPrefix)+import qualified Data.Text as T (pack, unpack, stripPrefix)+import Data.Text (Text)+import Data.Monoid ((<>)) -- -------------------------------------------------------------------- -- Command line options -- -data Flag = VersionF | SessionN String | EmptySession | DefaultSession | Help | Verbosity String+data Flag = VersionF | SessionN Text | EmptySession | DefaultSession | Help | Verbosity Text deriving (Show,Eq) options :: [OptDescr Flag]@@ -92,7 +94,7 @@ "Start with empty session" , Option ['d'] ["defaultSession"] (NoArg DefaultSession) "Start with default session (can be used together with a source file)"- , Option ['l'] ["loadSession"] (ReqArg SessionN "NAME")+ , Option ['l'] ["loadSession"] (ReqArg (SessionN . T.pack) "NAME") "Load session" , Option ['h'] ["help"] (NoArg Help)@@ -100,16 +102,16 @@ , Option ['v'] ["version"] (NoArg VersionF) "Show the version number of ide" - , Option ['e'] ["verbosity"] (ReqArg Verbosity "Verbosity")+ , Option ['e'] ["verbosity"] (ReqArg (Verbosity . T.pack) "Verbosity") "One of DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY"] header = "Usage: leksah [OPTION...] [file(.lkshs|.lkshw|.hs|.lhs)]" -ideOpts :: [String] -> IO ([Flag], [String])+ideOpts :: [Text] -> IO ([Flag], [Text]) ideOpts argv =- case getOpt Permute options argv of- (o,n,[] ) -> return (o,n)+ case getOpt Permute options $ map T.unpack argv of+ (o,n,[] ) -> return (o,map T.pack n) (_,_,errs) -> ioError $ userError $ concat errs ++ usageInfo header options -- ---------------------------------------------------------------------@@ -141,16 +143,16 @@ dataDir <- getDataDir args <- getArgs - (o,files) <- ideOpts args+ (o,files) <- ideOpts $ map T.pack args isFirstStart <- liftM not $ hasSavedConfigFile standardPreferencesFilename let sessions = catMaybes $ map (\x -> case x of SessionN s -> Just s _ -> Nothing) o - let sessionFPs = filter (\f -> snd (splitExtension f) == leksahSessionFileExtension) files- let workspaceFPs = filter (\f -> snd (splitExtension f) == leksahWorkspaceFileExtension) files+ let sessionFPs = filter (\f -> snd (splitExtension f) == leksahSessionFileExtension) $ map T.unpack files+ let workspaceFPs = filter (\f -> snd (splitExtension f) == leksahWorkspaceFileExtension) $ map T.unpack files let sourceFPs = filter (\f -> let (_,s) = splitExtension f- in s == ".hs" || s == ".lhs" || s == ".chs") files+ in s == ".hs" || s == ".lhs" || s == ".chs") $ map T.unpack files let mbWorkspaceFP'= case workspaceFPs of [] -> Nothing w:_ -> Just w@@ -164,7 +166,7 @@ then return (Just spath,Nothing) else return (Nothing,Just fp) let ssession = case sessions of- (s:_) -> s ++ leksahSessionFileExtension+ (s:_) -> T.unpack s <> leksahSessionFileExtension _ -> if null sourceFPs then standardSessionFilename else emptySessionFilename@@ -185,12 +187,12 @@ _ -> Nothing) o let verbosity = case verbosity' of [] -> INFO- h:_ -> read h+ h:_ -> read $ T.unpack h updateGlobalLogger rootLoggerName (\ l -> setLevel verbosity l) when (elem VersionF o)- (sysMessage Normal $ "Leksah the Haskell IDE, version " ++ showVersion version)+ (sysMessage Normal $ "Leksah the Haskell IDE, version " <> T.pack (showVersion version)) when (elem Help o)- (sysMessage Normal $ "Leksah the Haskell IDE " ++ usageInfo header options)+ (sysMessage Normal $ "Leksah the Haskell IDE " <> T.pack (usageInfo header options)) prefsPath <- getConfigFilePathForLoad standardPreferencesFilename Nothing dataDir prefs <- readPrefs prefsPath@@ -199,7 +201,7 @@ handleExceptions inner = catch inner (\(exception :: SomeException) -> do- sysMessage Normal ("leksah: internal IDE error: " ++ show exception)+ sysMessage Normal ("leksah: internal IDE error: " <> T.pack (show exception)) exitFailure ) @@ -213,7 +215,7 @@ when rtsSupportsBoundThreads (sysMessage Normal "Linked with -threaded") timeout <- timeoutAddFull (yield >> return True) priorityHigh 10- mapM_ (sysMessage Normal) st+ mapM_ (sysMessage Normal . T.pack) st initGtkRc dataDir <- getDataDir mbStartupPrefs <- if not isFirstStart@@ -232,16 +234,58 @@ Nothing -> return () Just startupPrefs -> startMainWindow yiControl sessionFP mbWorkspaceFP sourceFPs startupPrefs isFirstStart- unless rtsSupportsBoundThreads $ postGUIAsync mainLoop debugM "leksah" "starting mainGUI" mainGUI debugM "leksah" "finished mainGUI" -mainLoop :: IO ()-mainLoop = eventsPending >>= loop 50+mainLoop :: IO () -> IO ()+mainLoop = if rtsSupportsBoundThreads then mainLoopThreaded else mainLoopSingleThread++mainLoopThreaded :: IO () -> IO ()+mainLoopThreaded onIdle = loop+ where+ loop = do+ quit <- loopTillIdle+ if quit+ then return ()+ else do+ active <- newEmptyMVar+ mvarSentIdleMessage <- newEmptyMVar+ idleThread <- forkIO $ do+ threadDelay 50000+ isActive <- isJust <$> tryTakeMVar active+ unless isActive $ do+ putMVar mvarSentIdleMessage ()+ postGUIAsync onIdle+ quit <- mainIteration+ putMVar active ()+ if quit+ then return ()+ else do+ -- If an idle message was sent then wait again+ sentIdleMessage <- isJust <$> tryTakeMVar mvarSentIdleMessage+ quit <- if sentIdleMessage+ then mainIteration+ else return False+ if quit+ then return ()+ else loop+ loopTillIdle = do+ pending <- eventsPending+ if pending == 0+ then return False+ else do+ quit <- loopn (pending + 2)+ if quit+ then return True+ else loopTillIdle++mainLoopSingleThread :: IO () -> IO ()+mainLoopSingleThread onIdle = eventsPending >>= loop False 50 where- loop :: Int -> Int -> IO ()- loop delay n = do+ loop :: Bool -> Int -> Int -> IO ()+ loop False delay 0 | delay > 2000 = onIdle >> loop True delay 0+ loop isIdle delay n = do quit <- if n > 0 then do timeout <- timeoutAddFull (yield >> return True) priorityHigh 10@@ -257,23 +301,25 @@ pending <- eventsPending if pending > 0 then do- loop 50 pending+ loop False 50 pending else do threadDelay delay- eventsPending >>= loop (if n > 0- then 50- else min (delay+delay) 50000)- loopn :: Int -> IO Bool- loopn 0 = return False- loopn n = do- quit <- mainIterationDo False- if quit- then return True- else loopn (n - 1)+ eventsPending >>= loop isIdle (if n > 0+ then 50+ else min (delay+delay) 50000) +loopn :: Int -> IO Bool+loopn 0 = return False+loopn n = do+ quit <- mainIterationDo False+ if quit+ then return True+ else loopn (n - 1)+ startMainWindow :: Yi.Control -> FilePath -> Maybe FilePath -> [FilePath] -> Prefs -> Bool -> IO () startMainWindow yiControl sessionFP mbWorkspaceFP sourceFPs startupPrefs isFirstStart = do+ timeout <- timeoutAddFull (yield >> return True) priorityHigh 10 debugM "leksah" "startMainWindow" osxApp <- OSX.applicationNew uiManager <- uiManagerNew@@ -281,16 +327,16 @@ dataDir <- getDataDir candyPath <- getConfigFilePathForLoad (case sourceCandy startupPrefs of- (_,name) -> name ++ leksahCandyFileExtension) Nothing dataDir+ (_,name) -> T.unpack name <> leksahCandyFileExtension) Nothing dataDir candySt <- parseCandy candyPath -- keystrokes- keysPath <- getConfigFilePathForLoad (keymapName startupPrefs ++ leksahKeymapFileExtension) Nothing dataDir+ keysPath <- getConfigFilePathForLoad (T.unpack (keymapName startupPrefs) <> leksahKeymapFileExtension) Nothing dataDir keyMap <- parseKeymap keysPath let accelActions = setKeymap (keyMap :: KeymapI) mkActions specialKeys <- buildSpecialKeys keyMap accelActions win <- windowNew- widgetSetName win "Leksah Main Window"+ widgetSetName win ("Leksah Main Window"::Text) let fs = FrameState { windows = [win] , uiManager = uiManager@@ -341,7 +387,7 @@ reflectIDE (makeMenu uiManager accelActions menuDescription') ideR nb <- reflectIDE (newNotebook []) ideR after nb switchPage (\i -> reflectIDE (handleNotebookSwitch nb i) ideR)- widgetSetName nb $"root"+ widgetSetName nb ("root"::Text) on win deleteEvent . liftIO $ reflectIDE quit ideR >> return True reflectIDE (instrumentWindow win startupPrefs (castToWidget nb)) ideR reflectIDE (do@@ -396,11 +442,16 @@ workspaceTryQuiet $ workspaceAddPackage' welcomeCabal >> return () fileOpenThis welcomeMain) ideR reflectIDE (initInfo (modifyIDE_ (\ide -> ide{currentState = IsRunning}))) ideR- timeoutAddFull (do+ timeoutRemove timeout+ postGUIAsync . mainLoop $ reflectIDE (do currentPrefs <- readIDE prefs when (backgroundBuild currentPrefs) $ backgroundMake) ideR- return True) priorityDefaultIdle 1000+-- timeoutAddFull (do+-- reflectIDE (do+-- currentPrefs <- readIDE prefs+-- when (backgroundBuild currentPrefs) $ backgroundMake) ideR+-- return True) priorityDefaultIdle 1000 reflectIDE (triggerEvent ideR (Sensitivity [(SensitivityInterpreting, False)])) ideR return () -- mainGUI@@ -424,7 +475,7 @@ (paraName <<<- ParaName "URL from which to download prebuilt metadata" $ emptyParams) retrieveURL (\b a -> a{retrieveURL = b})- (stringEditor (\ _ -> True) True)+ (textEditor (\ _ -> True) True) , mkField (paraName <<<- ParaName "Strategy for downloading prebuilt metadata" $ emptyParams) retrieveStrategy@@ -443,18 +494,18 @@ dialog <- dialogNew setLeksahIcon dialog set dialog [- windowTitle := "Welcome to Leksah, the Haskell IDE",+ windowTitle := ("Welcome to Leksah, the Haskell IDE"::Text), windowWindowPosition := WinPosCenter]- dialogAddButton dialog "gtk-ok" ResponseOk- dialogAddButton dialog "gtk-cancel" ResponseCancel+ dialogAddButton dialog ("gtk-ok"::Text) ResponseOk+ dialogAddButton dialog ("gtk-cancel"::Text) ResponseCancel #ifdef MIN_VERSION_gtk3 vb <- dialogGetContentArea dialog #else vb <- dialogGetUpper dialog #endif label <- labelNew (Just (- "Before you start using Leksah it will collect and download metadata about your installed Haskell packages.\n" ++- "You can add folders under which you have sources for Haskell packages not available from Hackage."))+ "Before you start using Leksah it will collect and download metadata about your installed Haskell packages.\n" <>+ "You can add folders under which you have sources for Haskell packages not available from Hackage."::Text)) (widget, setInj, getExt,notifier) <- buildEditor (fDescription configDir) prefs boxPackStart (castToBox vb) label PackNatural 7 sw <- scrolledWindowNew Nothing Nothing@@ -502,7 +553,7 @@ dialog <- dialogNew setLeksahIcon dialog set dialog [- windowTitle := "Leksah: Updating Metadata",+ windowTitle := ("Leksah: Updating Metadata"::Text), windowWindowPosition := WinPosCenter, windowDeletable := False] #ifdef MIN_VERSION_gtk3@@ -511,13 +562,13 @@ vb <- dialogGetUpper dialog #endif progressBar <- progressBarNew- progressBarSetText progressBar "Please wait while Leksah collects information about Haskell packages on your system"+ progressBarSetText progressBar ("Please wait while Leksah collects information about Haskell packages on your system"::Text) progressBarSetFraction progressBar 0.0 boxPackStart (castToBox vb) progressBar PackGrow 7 forkIO $ do logger <- getRootLogger let verbosity = case getLevel logger of- Just level -> ["--verbosity=" ++ show level]+ Just level -> ["--verbosity=" <> T.pack (show level)] Nothing -> [] (output, pid) <- runTool "leksah-server" (["-sbo", "+RTS", "-N2", "-RTS"] ++ verbosity) Nothing output $$ CL.mapM_ (update progressBar)
src/IDE/LogRef.hs view
@@ -69,11 +69,12 @@ import Data.IORef (atomicModifyIORef, IORef, readIORef) import Data.Text (Text) import Control.Applicative ((<$>))-import qualified Data.Text as T (unpack, unlines, pack, null)+import qualified Data.Text as T+ (stripPrefix, isPrefixOf, unpack, unlines, pack, null) import Data.Monoid ((<>)) -showSourceSpan :: LogRef -> String-showSourceSpan = displaySrcSpan . logRefSrcSpan+showSourceSpan :: LogRef -> Text+showSourceSpan = T.pack . displaySrcSpan . logRefSrcSpan selectRef :: Maybe LogRef -> IDEAction selectRef (Just ref) = do@@ -109,7 +110,7 @@ unmarkLogRefs = do forOpenLogRefs $ \index logRef (IDEBuffer {sourceView = sv}) -> do buf <- getBuffer sv- removeTagByName buf (show (logRefType logRef) ++ show index)+ removeTagByName buf (T.pack $ show (logRefType logRef) ++ show index) setErrorList :: [LogRef] -> IDEAction setErrorList errs = do@@ -309,9 +310,9 @@ data BuildError = BuildLine | EmptyLine- | ErrorLine SrcSpan LogRefType String- | WarningLine String- | OtherLine String+ | ErrorLine SrcSpan LogRefType Text+ | WarningLine Text+ | OtherLine Text buildLineParser :: CharParser () BuildError buildLineParser = try (do@@ -331,7 +332,7 @@ symbol "Warning:" return WarningRef) <|> return ErrorRef- text <- many anyChar+ text <- T.pack <$> many anyChar return (ErrorLine span refType text)) <|> try (do whiteSpace@@ -340,10 +341,10 @@ <|> try (do whiteSpace symbol "Warning:"- text <- many anyChar- return (WarningLine ("Warning:" ++ text)))+ text <- T.pack <$> many anyChar+ return (WarningLine ("Warning:" <> text))) <|> try (do- text <- many anyChar+ text <- T.pack <$> many anyChar eof return (OtherLine text)) <?> "buildLineParser"@@ -455,14 +456,14 @@ defaultLogLaunch <- lift $ getDefaultLogLaunch logOutput defaultLogLaunch -logOutputPane :: String -> IORef [Text] -> C.Sink ToolOutput IDEM ()+logOutputPane :: Text -> IORef [Text] -> C.Sink ToolOutput IDEM () logOutputPane command buffer = do defaultLogLaunch <- lift $ getDefaultLogLaunch result <- catMaybes <$> logOutputLines defaultLogLaunch paneLineLogger when (not $ null result) $ do new <- liftIO . atomicModifyIORef buffer $ \x -> let new = x ++ result in (new, new) mbURI <- lift $ readIDE autoURI- unless (isJust mbURI) . lift . postSyncIDE . setOutput command $ T.unpack $ T.unlines new+ unless (isJust mbURI) . lift . postSyncIDE . setOutput command $ T.unlines new logOutputForBuild :: IDEPackage -> Bool@@ -479,7 +480,7 @@ let errorNum = length (filter isError errs) let warnNum = length errs - errorNum triggerEventIDE (StatusbarChanged [CompartmentState- (show errorNum ++ " Errors, " ++ show warnNum ++ " Warnings"), CompartmentBuild False])+ (T.pack $ show errorNum ++ " Errors, " ++ show warnNum ++ " Warnings"), CompartmentBuild False]) unless (backgroundBuild || (not jumpToWarnings && errorNum == 0)) nextError return errs) ideR where@@ -492,22 +493,22 @@ let nonErrorPrefixes = ["Linking ", "ar:", "ld:", "ld warning:"] tag <- case parsed of Right BuildLine -> return InfoTag- Right (OtherLine text) | "Linking " `isPrefixOf` text -> do+ Right (OtherLine text) | "Linking " `T.isPrefixOf` text -> do -- when backgroundBuild $ lift interruptProcess reflectIDE (do setErrorList $ reverse errs ) ideR return InfoTag- Right (OtherLine text) | any (`isPrefixOf` text) nonErrorPrefixes -> do+ Right (OtherLine text) | any (`T.isPrefixOf` text) nonErrorPrefixes -> do return InfoTag _ -> return ErrorTag lineNr <- Log.appendLog log logLaunch (line <> "\n") tag case (parsed, errs) of (Left e,_) -> do- sysMessage Normal (show e)+ sysMessage Normal . T.pack $ show e return (log, False, errs) (Right ne@(ErrorLine span refType str),_) ->- return (log, True, ((LogRef span package (T.pack str) (lineNr,lineNr) refType):errs))+ return (log, True, ((LogRef span package str (lineNr,lineNr) refType):errs)) (Right (OtherLine str1),(LogRef span rootPath str (l1,l2) refType):tl) -> if inError then return (log, True, ((LogRef span@@ -552,7 +553,7 @@ return (log, inError, errs) ---logOutputLines :: String -- ^ logLaunch+--logOutputLines :: Text -- ^ logLaunch -- -> (LogLaunch -> ToolOutput -> IDEM a) -- -> [ToolOutput] -- -> IDEM [a]@@ -599,14 +600,14 @@ logOutputForContext :: IDEPackage -> LogLaunch -- ^ loglaunch- -> (String -> [SrcSpan])+ -> (Text -> [SrcSpan]) -> C.Sink ToolOutput IDEM () logOutputForContext package loglaunch getContexts = do refs <- fmap catMaybes $ logOutputLines loglaunch (\log logLaunch out -> do case out of ToolOutput line -> do logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag- let contexts = getContexts $ T.unpack line+ let contexts = getContexts line if null contexts then return Nothing else return $ Just $ LogRef (last contexts) package line (logLineNumber, logLineNumber) ContextRef@@ -620,7 +621,7 @@ logOutputForLiveContext :: IDEPackage -> LogLaunch -- ^ loglaunch -> C.Sink ToolOutput IDEM ()-logOutputForLiveContext package logLaunch = logOutputForContext package logLaunch getContexts+logOutputForLiveContext package logLaunch = logOutputForContext package logLaunch (getContexts . T.unpack) where getContexts [] = [] getContexts line@(x:xs) = case stripPrefix "Stopped at " line of@@ -641,8 +642,8 @@ -> C.Sink ToolOutput IDEM () logOutputForHistoricContext package logLaunch = logOutputForContext package logLaunch getContexts where- getContexts line = case stripPrefix "Logged breakpoint at " line of- Just rest -> case parse srcSpanParser "" rest of+ getContexts line = case T.stripPrefix "Logged breakpoint at " line of+ Just rest -> case parse srcSpanParser "" $ T.unpack rest of Right desc -> [desc] _ -> [] _ -> []
src/IDE/Metainfo/Provider.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Metainfo.Provider@@ -56,13 +57,9 @@ import Text.Regex.TDFA import qualified Text.Regex.TDFA as Regex import System.IO.Unsafe (unsafePerformIO)-import Text.Regex.TDFA.String (execute,compile)+import Text.Regex.TDFA.Text (execute,compile) import Data.Binary.Shared (decodeSer)-#if MIN_VERSION_Cabal(1,16,0) import Language.Haskell.Extension (KnownExtension)-#else-import Language.Haskell.Extension (knownExtensions)-#endif import Distribution.Text (display) import IDE.Core.Serializable () import Data.Map (Map(..))@@ -72,8 +69,10 @@ import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Distribution.PackageDescription (hsSourceDirs)--trace a b = b+import System.Log.Logger (infoM)+import Data.Text (Text)+import qualified Data.Text as T (null, isPrefixOf, unpack, pack)+import Data.Monoid ((<>)) -- --------------------------------------------------------------------- -- Updating metadata@@ -94,7 +93,8 @@ updateWorkspaceInfo' False $ \ _ -> do triggerEventIDE (InfoChanged True) >> return () - trace "blah" $ continuation+ liftIO $ infoM "leksah" "initInfo continuing"+ continuation else do ideMessage Normal "Now loading metadata ..." loadSystemInfo@@ -104,19 +104,22 @@ continuation updateSystemInfo :: IDEAction-updateSystemInfo = trace "update sys info called" $ do+updateSystemInfo = do+ liftIO $ infoM "leksah" "update sys info called" updateSystemInfo' False $ \ _ -> updateWorkspaceInfo' False $ \ _ -> do triggerEventIDE (InfoChanged False) >> return () rebuildSystemInfo :: IDEAction-rebuildSystemInfo = trace "rebuild sys info called" $ do+rebuildSystemInfo = do+ liftIO $ infoM "leksah" "rebuild sys info called" updateSystemInfo' True $ \ _ -> updateWorkspaceInfo' True $ \ _ -> triggerEventIDE (InfoChanged False) >> return () updateWorkspaceInfo :: IDEAction-updateWorkspaceInfo = trace "update workspace info called" $ do+updateWorkspaceInfo = do+ liftIO $ infoM "leksah" "update workspace info called" currentState' <- readIDE currentState case currentState' of IsStartingUp -> return ()@@ -125,7 +128,8 @@ triggerEventIDE (InfoChanged False) >> return () rebuildWorkspaceInfo :: IDEAction-rebuildWorkspaceInfo = trace "rebuild workspace info called" $ do+rebuildWorkspaceInfo = do+ liftIO $ infoM "leksah" "rebuild workspace info called" updateWorkspaceInfo' True $ \ _ -> do triggerEventIDE (InfoChanged False) >> return () @@ -171,14 +175,14 @@ (map fromJust $ filter isJust newPackageInfos) let psmap3 = foldr (\e m -> Map.delete e m) psmap2 trashPackages- let scope :: PackScope (Map String [Descr])+ let scope :: PackScope (Map Text [Descr]) = foldr buildScope (PackScope Map.empty symEmpty) (Map.elems psmap3) modifyIDE_ (\ide -> ide{systemInfo = Just (GenScopeC (addOtherToScope scope False))}) continuation True ideMessage Normal "Finished updating system metadata" -getEmptyDefaultScope :: Map String [Descr]+getEmptyDefaultScope :: Map Text [Descr] getEmptyDefaultScope = symEmpty -- -- | Rebuilds system info@@ -201,7 +205,8 @@ systemInfo' <- getSystemInfo case mbWorkspace of Nothing -> do- trace "no workspace" $ modifyIDE_ (\ide -> ide{workspaceInfo = Nothing, packageInfo = Nothing})+ liftIO $ infoM "leksah" "updateWorkspaceInfo' no workspace"+ modifyIDE_ (\ide -> ide{workspaceInfo = Nothing, packageInfo = Nothing}) continuation False Just ws -> do updatePackageInfos rebuild (wsAllPackages ws) $ \ _ packDescrs -> do@@ -211,9 +216,9 @@ Nothing -> [] Just (GenScopeC (PackScope pdmap _)) -> catMaybes $ map (\ pid -> pid `Map.lookup` pdmap) dependPackIds- let scope1 :: PackScope (Map String [Descr])+ let scope1 :: PackScope (Map Text [Descr]) = foldr buildScope (PackScope Map.empty symEmpty) packDescrs- let scope2 :: PackScope (Map String [Descr])+ let scope2 :: PackScope (Map Text [Descr]) = foldr buildScope (PackScope Map.empty symEmpty) packDescrsI modifyIDE_ (\ide -> ide{workspaceInfo = Just (GenScopeC (addOtherToScope scope1 True), GenScopeC(addOtherToScope scope2 False))})@@ -238,9 +243,9 @@ if (elem (pdPackage pd) workspacePackageIds) then find (\pd' -> pdPackage pd == pdPackage pd') packDescrs else Nothing) impPackDescrs- scope1 :: PackScope (Map String [Descr])+ scope1 :: PackScope (Map Text [Descr]) = buildScope pd (PackScope Map.empty symEmpty)- scope2 :: PackScope (Map String [Descr])+ scope2 :: PackScope (Map Text [Descr]) = foldr buildScope (PackScope Map.empty symEmpty) (impPackDescrs' ++ impPackDescrs'') in modifyIDE_ (\ide -> ide{packageInfo = Just@@ -259,8 +264,8 @@ updatePackageInfos' (packDescr : collector) rebuild tail continuation updatePackageInfo :: Bool -> IDEPackage -> (Bool -> PackageDescr -> IDEAction) -> IDEAction-updatePackageInfo rebuild idePack continuation =- trace ("updatePackageInfo " ++ show (ipdPackageId idePack)) $ do+updatePackageInfo rebuild idePack continuation = do+ liftIO $ infoM "leksah" ("updatePackageInfo " ++ show rebuild ++ " " ++ show (ipdPackageId idePack)) workspInfoCache' <- readIDE workspInfoCache let (packageMap, ic) = case pi `Map.lookup` workspInfoCache' of Nothing -> (Map.empty,True)@@ -286,16 +291,16 @@ modToUpdate <- if rebuild then return modWithSources else liftIO $ figureOutRealSources idePack modWithSources- trace ("updatePackageInfo modToUpdate " ++ show (map (display.fst) modToUpdate)) $- callCollectorWorkspace+ liftIO . infoM "leksah" $ "updatePackageInfo modToUpdate " ++ show (map (display.fst) modToUpdate)+ callCollectorWorkspace rebuild (dropFileName (ipdCabalFile idePack)) (ipdPackageId idePack)- (map (\(x,y) -> (display x,y)) modToUpdate)+ (map (\(x,y) -> (T.pack $ display x,y)) modToUpdate) (\ b -> do buildDepends <- liftIO $ findFittingPackages (ipdDepends idePack) collectorPath <- liftIO $ getCollectorPath- let packageCollectorPath = collectorPath </> packageIdentifierToString pi+ let packageCollectorPath = collectorPath </> T.unpack (packageIdentifierToString pi) (moduleDescrs,packageMap, changed, modWithout) <- liftIO $ foldM (getModuleDescr packageCollectorPath)@@ -310,13 +315,13 @@ pdBuildDepends = buildDepends})) where basePath = normalise $ (takeDirectory (ipdCabalFile idePack))- srcDirs' bi = map (basePath </>) (hsSourceDirs bi)+ srcDirs' bi = map (basePath </>) ("dist/build":(hsSourceDirs bi)) pi = ipdPackageId idePack figureOutRealSources :: IDEPackage -> [(ModuleName,FilePath)] -> IO [(ModuleName,FilePath)] figureOutRealSources idePack modWithSources = do collectorPath <- getCollectorPath- let packageCollectorPath = collectorPath </> packageIdentifierToString (ipdPackageId idePack)+ let packageCollectorPath = collectorPath </> T.unpack (packageIdentifierToString $ ipdPackageId idePack) filterM (ff packageCollectorPath) modWithSources where ff packageCollectorPath (md ,fp) = do@@ -348,8 +353,8 @@ if modificationTime == eTime then return (mdescr:modDescrs,packageMap,changed,problemMods) else do- mbNewDescr <- trace ("loadInfo: " ++ display modName) $- loadInfosForModule moduleCollectorPath+ liftIO . infoM "leksah" $ "getModuleDescr loadInfo: " ++ display modName+ mbNewDescr <- loadInfosForModule moduleCollectorPath case mbNewDescr of Just newDescr -> return (newDescr:modDescrs, Map.insert modName (modificationTime,mbFilePath,newDescr) packageMap,@@ -382,20 +387,20 @@ -- loadInfosForPackage :: FilePath -> PackageIdentifier -> IO (Maybe PackageDescr) loadInfosForPackage dirPath pid = do- let filePath = dirPath </> packageIdentifierToString pid ++ leksahMetadataSystemFileExtension- let filePath2 = dirPath </> packageIdentifierToString pid ++ leksahMetadataPathFileExtension+ let filePath = dirPath </> T.unpack (packageIdentifierToString pid) ++ leksahMetadataSystemFileExtension+ let filePath2 = dirPath </> T.unpack (packageIdentifierToString pid) ++ leksahMetadataPathFileExtension exists <- doesFileExist filePath if exists then catch (do file <- openBinaryFile filePath ReadMode- trace ("now loading metadata for package " ++ packageIdentifierToString pid) return ()+ liftIO . infoM "leksah" . T.unpack $ "now loading metadata for package " <> packageIdentifierToString pid bs <- BSL.hGetContents file let (metadataVersion'::Integer, packageInfo::PackageDescr) = decodeSer bs if metadataVersion /= metadataVersion' then do hClose file throwIDE ("Metadata has a wrong version."- ++ " Consider rebuilding metadata with: leksah-server -osb +RTS -N2 -RTS")+ <> " Consider rebuilding metadata with: leksah-server -osb +RTS -N2 -RTS") else do packageInfo `deepseq` (hClose file) exists' <- doesFileExist filePath2@@ -406,10 +411,10 @@ return (Just packageInfo')) (\ (e :: SomeException) -> do sysMessage Normal- ("loadInfosForPackage: " ++ packageIdentifierToString pid ++ " Exception: " ++ show e)+ ("loadInfosForPackage: " <> packageIdentifierToString pid <> " Exception: " <> T.pack (show e)) return Nothing) else do- sysMessage Normal $"packageInfo not found for " ++ packageIdentifierToString pid+ sysMessage Normal $"packageInfo not found for " <> packageIdentifierToString pid return Nothing injectSourceInPack :: Maybe FilePath -> PackageDescr -> PackageDescr@@ -442,13 +447,13 @@ then do hClose file throwIDE ("Metadata has a wrong version."- ++ " Consider rebuilding metadata with -r option")+ <> " Consider rebuilding metadata with -r option") else do moduleInfo `deepseq` (hClose file) return (Just moduleInfo))- (\ (e :: SomeException) -> do sysMessage Normal ("loadInfosForModule: " ++ show e); return Nothing)+ (\ (e :: SomeException) -> do sysMessage Normal (T.pack $ "loadInfosForModule: " ++ show e); return Nothing) else do- sysMessage Normal $"moduleInfo not found for " ++ filePath+ sysMessage Normal $ "moduleInfo not found for " <> T.pack filePath return Nothing findFittingPackages :: [Dependency] -> IO [PackageIdentifier]@@ -483,7 +488,7 @@ -- -- | Lookup of an identifier description ---getIdentifierDescr :: (SymbolTable alpha, SymbolTable beta) => String -> alpha -> beta -> [Descr]+getIdentifierDescr :: (SymbolTable alpha, SymbolTable beta) => Text -> alpha -> beta -> [Descr] getIdentifierDescr str st1 st2 = let r1 = str `symLookup` st1 r2 = str `symLookup` st2@@ -492,9 +497,9 @@ -- -- | Lookup of an identifiers starting with the specified prefix and return a list. ---getIdentifiersStartingWith :: (SymbolTable alpha , SymbolTable beta) => String -> alpha -> beta -> [String]+getIdentifiersStartingWith :: (SymbolTable alpha , SymbolTable beta) => Text -> alpha -> beta -> [Text] getIdentifiersStartingWith prefix st1 st2 =- takeWhile (isPrefixOf prefix) $+ takeWhile (T.isPrefixOf prefix) $ if memberLocal || memberGlobal then prefix : Set.toAscList names else@@ -504,7 +509,7 @@ (_, memberGlobal, globalNames) = Set.splitMember prefix (symbols st2) names = Set.union globalNames localNames -getCompletionOptions :: String -> IDEM [String]+getCompletionOptions :: Text -> IDEM [Text] getCompletionOptions prefix = do workspaceInfo' <- getWorkspaceInfo case workspaceInfo' of@@ -512,13 +517,13 @@ Just ((GenScopeC (PackScope _ symbolTable1)),(GenScopeC (PackScope _ symbolTable2))) -> return $ getIdentifiersStartingWith prefix symbolTable1 symbolTable2 -getDescription :: String -> IDEM String+getDescription :: Text -> IDEM Text getDescription name = do workspaceInfo' <- getWorkspaceInfo case workspaceInfo' of Nothing -> return "" Just ((GenScopeC (PackScope _ symbolTable1)),(GenScopeC (PackScope _ symbolTable2))) ->- return ((foldr (\d f -> shows (Present d) . showChar '\n' . f) id+ return $ T.pack ((foldr (\d f -> shows (Present d) . showChar '\n' . f) id (getIdentifierDescr name symbolTable1 symbolTable2)) "") getPackageInfo :: IDEM (Maybe (GenScope, GenScope))@@ -539,18 +544,26 @@ then do packageInfo' <- getPackageInfo case packageInfo' of- Nothing -> trace "getPackageImportInfo: no package info" $ return Nothing+ Nothing -> do+ liftIO $ infoM "leksah" "getPackageImportInfo: no package info"+ return Nothing Just ((GenScopeC (PackScope pdmap _)),_) -> do case Map.lookup (ipdPackageId idePack) pdmap of- Nothing -> trace "getPackageImportInfo: package not found in package" $ return Nothing+ Nothing -> do+ liftIO $ infoM "leksah" "getPackageImportInfo: package not found in package"+ return Nothing Just pd -> buildIt pd systemInfo' else do workspaceInfo <- getWorkspaceInfo case workspaceInfo of- Nothing -> trace "getPackageImportInfo: no workspace info" $ return Nothing+ Nothing -> do+ liftIO $ infoM "leksah" "getPackageImportInfo: no workspace info"+ return Nothing Just ((GenScopeC (PackScope pdmap _)),_) -> case Map.lookup (ipdPackageId idePack) pdmap of- Nothing -> trace "getPackageImportInfo: package not found in workspace" $ return Nothing+ Nothing -> do+ liftIO $ infoM "leksah" "getPackageImportInfo: package not found in workspace"+ return Nothing Just pd -> buildIt pd systemInfo' where@@ -558,21 +571,23 @@ filterPrivate md = md{mdIdDescriptions = filter dscExported (mdIdDescriptions md)} buildIt pd systemInfo' = case systemInfo' of- Nothing -> trace "getPackageImportInfo: no system info" $ return Nothing+ Nothing -> do+ liftIO $ infoM "leksah" "getPackageImportInfo: no system info"+ return Nothing Just (GenScopeC (PackScope pdmap' _)) -> let impPackDescrs = catMaybes $ map (\ pid -> pid `Map.lookup` pdmap') (pdBuildDepends pd) pd' = pd{pdModules = map filterPrivate (pdModules pd)}- scope1 :: PackScope (Map String [Descr])+ scope1 :: PackScope (Map Text [Descr]) = buildScope pd (PackScope Map.empty symEmpty)- scope2 :: PackScope (Map String [Descr])+ scope2 :: PackScope (Map Text [Descr]) = foldr buildScope (PackScope Map.empty symEmpty) impPackDescrs in return (Just (GenScopeC scope1, GenScopeC scope2)) -- -- | Searching of metadata -- -searchMeta :: Scope -> String -> SearchMode -> IDEM [Descr]+searchMeta :: Scope -> Text -> SearchMode -> IDEM [Descr] searchMeta _ "" _ = return [] searchMeta (PackageScope False) searchString searchType = do packageInfo' <- getPackageInfo@@ -613,47 +628,49 @@ Just ((GenScopeC (PackScope _ rl)),_) -> return (searchInScope searchType searchString rl ++ searchInScope searchType searchString s) -searchInScope :: SymbolTable alpha => SearchMode -> String -> alpha -> [Descr]+searchInScope :: SymbolTable alpha => SearchMode -> Text -> alpha -> [Descr] searchInScope (Exact _) l st = searchInScopeExact l st searchInScope (Prefix True) l st = (concat . symElems) (searchInScopePrefix l st)-searchInScope (Prefix False) [] _ = []+searchInScope (Prefix False) l _ | T.null l = [] searchInScope (Prefix False) l st = (concat . symElems) (searchInScopeCaseIns l st "") searchInScope (Regex b) l st = searchRegex l st b -searchInScopeExact :: SymbolTable alpha => String -> alpha -> [Descr]+searchInScopeExact :: SymbolTable alpha => Text -> alpha -> [Descr] searchInScopeExact = symLookup -searchInScopePrefix :: SymbolTable alpha => String -> alpha -> alpha+searchInScopePrefix :: SymbolTable alpha => Text -> alpha -> alpha searchInScopePrefix searchString symbolTable = let (_, exact, mapR) = symSplitLookup searchString symbolTable- (mbL, _, _) = symSplitLookup (searchString ++ "{") mapR+ (mbL, _, _) = symSplitLookup (searchString <> "{") mapR in case exact of Nothing -> mbL Just e -> symInsert searchString e mbL -searchInScopeCaseIns :: SymbolTable alpha => String -> alpha -> String -> alpha-searchInScopeCaseIns [] st _ = st-searchInScopeCaseIns (a:l) st pre | isLower a =+searchInScopeCaseIns :: SymbolTable alpha => Text -> alpha -> Text -> alpha+searchInScopeCaseIns a symbolTable b = searchInScopeCaseIns' (T.unpack a) symbolTable (T.unpack b)+ where+ searchInScopeCaseIns' [] st _ = st+ searchInScopeCaseIns' (a:l) st pre | isLower a = let s1 = pre ++ [a] s2 = pre ++ [toUpper a]- in (symUnion (searchInScopeCaseIns l (searchInScopePrefix s1 st) s1)- (searchInScopeCaseIns l (searchInScopePrefix s2 st) s2))+ in (symUnion (searchInScopeCaseIns' l (searchInScopePrefix (T.pack s1) st) s1)+ (searchInScopeCaseIns' l (searchInScopePrefix (T.pack s2) st) s2)) | isUpper a = let s1 = pre ++ [a] s2 = pre ++ [toLower a]- in (symUnion (searchInScopeCaseIns l (searchInScopePrefix s1 st) s1)- (searchInScopeCaseIns l (searchInScopePrefix s2 st) s2))+ in (symUnion (searchInScopeCaseIns' l (searchInScopePrefix (T.pack s1) st) s1)+ (searchInScopeCaseIns' l (searchInScopePrefix (T.pack s2) st) s2)) | otherwise = let s = pre ++ [a]- in searchInScopeCaseIns l (searchInScopePrefix s st) s+ in searchInScopeCaseIns' l (searchInScopePrefix (T.pack s) st) s -searchRegex :: SymbolTable alpha => String -> alpha -> Bool -> [Descr]+searchRegex :: SymbolTable alpha => Text -> alpha -> Bool -> [Descr] searchRegex searchString st caseSense = case compileRegex caseSense searchString of Left err ->- unsafePerformIO $ sysMessage Normal (show err) >> return []+ unsafePerformIO $ sysMessage Normal (T.pack $ show err) >> return [] Right regex -> filter (\e -> do case execute regex (dscName e) of@@ -662,7 +679,7 @@ _ -> True) (concat (symElems st)) -compileRegex :: Bool -> String -> Either String Regex+compileRegex :: Bool -> Text -> Either String Regex compileRegex caseSense searchString = let compOption = defaultCompOpt { Regex.caseSensitive = caseSense@@ -733,39 +750,55 @@ -- callCollector :: Bool -> Bool -> Bool -> (Bool -> IDEAction) -> IDEAction-callCollector rebuild sources extract cont = trace "callCollector" $ do+callCollector rebuild sources extract cont = do+ liftIO $ infoM "leksah" "callCollector" doServerCommand command $ \ res -> case res of- ServerOK -> trace "callCollector finished" $ cont True- ServerFailed str -> trace str $ cont False- _ -> trace "impossible server answer" $ cont False+ ServerOK -> do+ liftIO $ infoM "leksah" "callCollector finished"+ cont True+ ServerFailed str -> do+ liftIO $ infoM "leksah" (T.unpack str)+ cont False+ _ -> do+ liftIO $ infoM "leksah" "impossible server answer"+ cont False where command = SystemCommand { scRebuild = rebuild, scSources = sources, scExtract = extract} -callCollectorWorkspace :: Bool -> FilePath -> PackageIdentifier -> [(String,FilePath)] ->+callCollectorWorkspace :: Bool -> FilePath -> PackageIdentifier -> [(Text,FilePath)] -> (Bool -> IDEAction) -> IDEAction-callCollectorWorkspace rebuild fp pi modList cont = trace "callCollectorWorkspace" $+callCollectorWorkspace rebuild fp pi modList cont = do+ liftIO $ infoM "leksah" "callCollectorWorkspace" if null modList- then trace "callCollectorWorkspace: Nothing to do" $ cont True+ then do+ liftIO $ infoM "leksah" "callCollectorWorkspace: Nothing to do"+ cont True else do doServerCommand command $ \ res -> case res of- ServerOK -> trace "callCollectorWorkspace finished" $ cont True- ServerFailed str -> trace str $ cont False- _ -> trace "impossible server answer" $ cont False+ ServerOK -> do+ liftIO $ infoM "leksah" "callCollectorWorkspace finished"+ cont True+ ServerFailed str -> do+ liftIO $ infoM "leksah" (T.unpack str)+ cont False+ _ -> do+ liftIO $ infoM "leksah" "impossible server answer"+ cont False where command = WorkspaceCommand {- wcRebuild = rebuild,- wcPackage = pi,- wcPath = fp,- wcModList = modList}+ wcRebuild = rebuild,+ wcPackage = pi,+ wcPath = fp,+ wcModList = modList} -- --------------------------------------------------------------------- -- Additions for completion -- -keywords :: [String]+keywords :: [Text] keywords = [ "as" , "case"@@ -807,22 +840,18 @@ extensionDescrs :: [Descr] extensionDescrs = map (\ext -> Real $ RealDescr- ("X" ++ show ext)+ (T.pack $ "X" ++ show ext) Nothing Nothing Nothing (Just (BS.pack " Haskell language extension")) ExtensionDescr True)-#if MIN_VERSION_Cabal(1,16,0) ([minBound..maxBound]::[KnownExtension])-#else- knownExtensions-#endif moduleNameDescrs :: PackageDescr -> [Descr] moduleNameDescrs pd = map (\md -> Real $ RealDescr- ((display . modu . mdModuleId) md)+ (T.pack . display . modu $ mdModuleId md) Nothing (Just (mdModuleId md)) Nothing
src/IDE/NotebookFlipper.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.NotebookFlipper
src/IDE/OSX.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.OSX@@ -29,24 +30,25 @@ import Control.Monad.Reader.Class (ask) import Graphics.UI.Gtk.OSX import IDE.Command (canQuit)+import Data.Text (Text) updateMenu :: Application -> UIManager -> IDEM () updateMenu app uiManager = do ideR <- ask liftIO $ do- mbMenu <- uiManagerGetWidget uiManager "/ui/menubar"+ mbMenu <- uiManagerGetWidget uiManager ("/ui/menubar" :: Text) case mbMenu of Just menu -> do widgetHide menu applicationSetMenuBar app (castToMenuShell menu) Nothing -> return () - mbQuit <- uiManagerGetWidget uiManager "/ui/menubar/_File/_Quit"+ mbQuit <- uiManagerGetWidget uiManager ("/ui/menubar/_File/_Quit" :: Text) case mbQuit of Just quit -> widgetHide quit Nothing -> return () - mbAbout <- uiManagerGetWidget uiManager "/ui/menubar/_Help/_About"+ mbAbout <- uiManagerGetWidget uiManager ("/ui/menubar/_Help/_About" :: Text) case mbAbout of Just about -> do applicationInsertAppMenuItem app (castToMenuItem about) 0@@ -54,7 +56,7 @@ applicationInsertAppMenuItem app sep 1 Nothing -> return () - mbPrefs <- uiManagerGetWidget uiManager "/ui/menubar/_Configuration/Edit general Preferences"+ mbPrefs <- uiManagerGetWidget uiManager ("/ui/menubar/_Configuration/Edit general Preferences" :: Text) case mbPrefs of Just prefs -> do applicationInsertAppMenuItem app (castToMenuItem prefs) 2
src/IDE/Package.hs view
@@ -92,7 +92,6 @@ import Distribution.Text (display) import IDE.Utils.FileUtils(getConfigFilePathForLoad) import IDE.LogRef-import MyMissing (replace) import Distribution.ModuleName (ModuleName(..)) import Data.List (isInfixOf, nub, foldl', delete) import qualified System.IO.UTF8 as UTF8 (readFile)@@ -100,12 +99,11 @@ import qualified Data.Set as Set (fromList) import qualified Data.Map as Map (empty, fromList) import System.Exit (ExitCode(..))-import Control.Applicative ((<$>))+import Control.Applicative ((<$>), (<*>)) import IDE.Utils.Tool (executeGhciCommand, getProcessExitCode, interruptProcessGroupOf, ProcessHandle)-import qualified Data.Conduit as C (Sink)+import qualified Data.Conduit as C (Sink, ZipSink(..), getZipSink) import qualified Data.Conduit.List as CL (foldM, fold, consume)-import qualified Data.Conduit.Util as CU (zipSinks) import Data.Conduit (($$)) import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..))@@ -117,13 +115,21 @@ import IDE.Pane.WebKit.Documentation (getDocumentation, loadDoc, reloadDoc) import IDE.Pane.WebKit.Output (loadOutputUri, getOutputPane)-import Text.Printf (printf) import System.Log.Logger (debugM) import System.Process.Vado (getMountPoint, vado, readSettings)-import qualified Data.Text as T (pack, unpack, isInfixOf)+import qualified Data.Text as T+ (replace, unwords, takeWhile, pack, unpack, isInfixOf) import IDE.Utils.ExternalTool (runExternalTool', runExternalTool, isRunning, interruptBuild) import Text.PrinterParser (writeFields)+import Data.Text (Text)+import Data.Monoid ((<>))+import qualified Data.Text.IO as T (readFile)+import qualified Text.Printf as S (printf)+import Text.Printf (PrintfType) +printf :: PrintfType r => Text -> r+printf = S.printf . T.unpack+ -- | Get the last item sinkLast = CL.fold (\_ a -> Just a) Nothing @@ -138,7 +144,7 @@ myTestModules pd = concatMap (moduleInfo testBuildInfo (otherModules . testBuildInfo)) (testSuites pd) myBenchmarkModules pd = concatMap (moduleInfo benchmarkBuildInfo (otherModules . benchmarkBuildInfo)) (benchmarks pd) -activatePackage :: Maybe FilePath -> Maybe IDEPackage -> Maybe String -> IDEM ()+activatePackage :: Maybe FilePath -> Maybe IDEPackage -> Maybe Text -> IDEM () activatePackage mbPath mbPack mbExe = do liftIO $ debugM "leksah" "activatePackage" oldActivePack <- readIDE activePack@@ -154,9 +160,9 @@ Nothing -> "" Just ws -> wsName ws txt = case (mbPath, mbPack) of- (_, Just pack) -> wsStr ++ " > " ++ packageIdentifierToString (ipdPackageId pack)- (Just path, _) -> wsStr ++ " > " ++ takeFileName path- _ -> wsStr ++ ":"+ (_, Just pack) -> wsStr <> " > " <> packageIdentifierToString (ipdPackageId pack)+ (Just path, _) -> wsStr <> " > " <> T.pack (takeFileName path)+ _ -> wsStr <> ":" triggerEventIDE (StatusbarChanged [CompartmentPackage txt]) return () @@ -179,7 +185,7 @@ (cabalCommand prefs) (["configure"] ++ (ipdConfigFlags package)) dir $ do- (mbLastOutput, _) <- CU.zipSinks sinkLast (logOutput logLaunch)+ mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink (logOutput logLaunch) lift $ do mbPack <- idePackageFromPath (logOutput logLaunch) (ipdCabalFile package) case mbPack of@@ -204,8 +210,10 @@ ++ ipdBuildFlags package ++ (if runTests then ipdTestFlags package else [])) runExternalTool' (__ "Building") (cabalCommand prefs) args dir $ do- (mbLastOutput, (isConfigErr, _)) <- CU.zipSinks sinkLast $ CU.zipSinks isConfigError $- logOutputForBuild package backgroundBuild jumpToWarnings+ (mbLastOutput, isConfigErr, _) <- C.getZipSink $ (,,)+ <$> C.ZipSink sinkLast+ <*> C.ZipSink isConfigError+ <*> (C.ZipSink $ logOutputForBuild package backgroundBuild jumpToWarnings) lift $ do errs <- readIDE errorRefs if shallConfigure && isConfigErr@@ -221,9 +229,9 @@ where isCErr (ToolError str) = str1 `T.isInfixOf` str || str2 `T.isInfixOf` str || str3 `T.isInfixOf` str isCErr _ = False- str1 = T.pack (__ "Run the 'configure' command first")- str2 = T.pack (__ "please re-configure")- str3 = T.pack (__ "cannot satisfy -package-id")+ str1 = __ "Run the 'configure' command first"+ str2 = __ "please re-configure"+ str3 = __ "cannot satisfy -package-id" buildPackage :: Bool -> Bool -> Bool -> Bool -> IDEPackage -> (Bool -> IDEAction) -> IDEAction buildPackage backgroundBuild runTests jumpToWarnings withoutLinking package continuation = catchIDE (do@@ -248,7 +256,7 @@ when f $ do mbURI <- readIDE autoURI case mbURI of- Just uri -> postSyncIDE $ loadOutputUri uri+ Just uri -> postSyncIDE . loadOutputUri $ T.unpack uri Nothing -> return () continuation f Just debug@(_, ghci) -> do@@ -264,7 +272,7 @@ liftIO . postGUISync $ reflectIDE cmd ideR lift $ continuation True )- (\(e :: SomeException) -> sysMessage Normal (show e))+ (\(e :: SomeException) -> sysMessage Normal (T.pack $ show e)) packageDoc :: PackageAction packageDoc = do@@ -278,8 +286,8 @@ let dir = ipdBuildDir package runExternalTool' (__ "Documenting") (cabalCommand prefs) (["haddock"] ++ (ipdHaddockFlags package)) dir $ do- (mbLastOutput, _) <- CU.zipSinks sinkLast $- logOutputForBuild package backgroundBuild jumpToWarnings+ mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> (C.ZipSink $+ logOutputForBuild package backgroundBuild jumpToWarnings) lift $ reloadDoc lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess))) (\(e :: SomeException) -> putStrLn (show e))@@ -300,7 +308,7 @@ (cabalCommand prefs) ["clean"] dir $ do- (mbLastOutput, _) <- CU.zipSinks sinkLast (logOutput logLaunch)+ mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink (logOutput logLaunch) lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess)) packageCopy :: PackageAction@@ -320,7 +328,7 @@ let dir = ipdBuildDir package runExternalTool' (__ "Copying") (cabalCommand prefs)- (["copy"] ++ ["--destdir=" ++ fp])+ (["copy"] ++ ["--destdir=" <> T.pack fp]) dir (logOutput logLaunch)) (\(e :: SomeException) -> putStrLn (show e))@@ -353,7 +361,7 @@ let dir = ipdBuildDir package runExternalTool' (__ "Copying") (cabalCommand prefs) (["copy"] ++ (ipdInstallFlags package)) dir $ do- (mbLastOutput, _) <- CU.zipSinks sinkLast (logOutput logLaunch)+ mbLastOutput <- C.getZipSink $ (const <$> C.ZipSink sinkLast) <*> C.ZipSink (logOutput logLaunch) lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess))) (\(e :: SomeException) -> putStrLn (show e)) @@ -361,14 +369,14 @@ packageRun = ask >>= (liftIDE . packageRun' True) packageRun' :: Bool -> IDEPackage -> IDEAction-packageRun' addFlagIfMissing package = do- if addFlagIfMissing && "--ghcjs" `elem` ipdConfigFlags package && not ("--ghcjs-option=--native-executables" `elem` ipdConfigFlags package)+packageRun' removeGhcjsFlagIfPresent package = do+ if removeGhcjsFlagIfPresent && "--ghcjs" `elem` ipdConfigFlags package then do window <- liftIDE $ getMainWindow resp <- liftIO $ do md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- (__ "Package is configured to use GHCJS. Would you like to add --ghcjs-option=--native-executables to the configure flags and rebuild?")- dialogAddButton md (__ "Add _GHCJS Native Executables") (ResponseUser 1)+ (__ "Package is configured to use GHCJS. Would you like to remove --ghcjs from the configure flags and rebuild?")+ dialogAddButton md (__ "Use _GHC") (ResponseUser 1) dialogSetDefaultResponse md (ResponseUser 1) set md [ windowWindowPosition := WinPosCenterOnParent ] resp <- dialogRun md@@ -376,7 +384,7 @@ return resp case resp of ResponseUser 1 -> do- let packWithNewFlags = package { ipdConfigFlags = ["--ghcjs-option=--native-executables"] ++ ipdConfigFlags package }+ let packWithNewFlags = package { ipdConfigFlags = filter (/="--ghcjs") $ ipdConfigFlags package } changePackage packWithNewFlags liftIO $ writeFlags (dropExtension (ipdCabalFile packWithNewFlags) ++ leksahFlagFileExtension) packWithNewFlags packageConfig' packWithNewFlags $ \ ok -> when ok $ do@@ -388,18 +396,18 @@ pd <- liftIO $ readPackageDescription normal (ipdCabalFile package) >>= return . flattenPackageDescription mbExe <- readIDE activeExe let exe = take 1 . filter (isActiveExe mbExe) $ executables pd- let defaultLogName = display . pkgName $ ipdPackageId package- logName = fromMaybe defaultLogName . listToMaybe $ map exeName exe+ let defaultLogName = T.pack . display . pkgName $ ipdPackageId package+ logName = fromMaybe defaultLogName . listToMaybe $ map (T.pack . exeName) exe (logLaunch,logName) <- buildLogLaunchByName logName case maybeDebug of Nothing -> do let dir = ipdBuildDir package IDE.Package.runPackage (addLogLaunchData logName logLaunch)- (printf (__ "Running %s") logName)+ (T.pack $ printf (__ "Running %s") (T.unpack logName)) "cabal" (concat [["run"] , ipdBuildFlags package- , map exeName exe+ , map (T.pack . exeName) exe , ["--"] , ipdExeFlags package]) dir@@ -409,13 +417,14 @@ runDebug (do case exe of [Executable name mainFilePath _] -> do- executeDebugCommand (":module *" ++ (map (\c -> if c == '/' then '.' else c) (takeWhile (/= '.') mainFilePath))) (logOutput logLaunch)+ executeDebugCommand (":module *" <> T.pack (map (\c -> if c == '/' then '.' else c) (takeWhile (/= '.') mainFilePath)))+ (logOutput logLaunch) _ -> return ()- executeDebugCommand (":main " ++ (unwords (ipdExeFlags package))) (logOutput logLaunch))+ executeDebugCommand (":main " <> T.unwords (ipdExeFlags package)) (logOutput logLaunch)) debug) (\(e :: SomeException) -> putStrLn (show e)) where- isActiveExe selected (Executable name _ _) = selected == Just name+ isActiveExe selected (Executable name _ _) = selected == Just (T.pack name) packageRunJavaScript :: PackageAction packageRunJavaScript = ask >>= (liftIDE . packageRunJavaScript' True)@@ -448,8 +457,8 @@ pd <- liftIO $ readPackageDescription normal (ipdCabalFile package) >>= return . flattenPackageDescription mbExe <- readIDE activeExe let exe = take 1 . filter (isActiveExe mbExe) $ executables pd- let defaultLogName = display . pkgName $ ipdPackageId package- logName = fromMaybe defaultLogName . listToMaybe $ map exeName exe+ let defaultLogName = T.pack . display . pkgName $ ipdPackageId package+ logName = fromMaybe defaultLogName . listToMaybe $ map (T.pack . exeName) exe (logLaunch,logName) <- buildLogLaunchByName logName let dir = ipdBuildDir package prefs <- readIDE prefs@@ -469,7 +478,7 @@ _ -> return ()) (\(e :: SomeException) -> putStrLn (show e)) where- isActiveExe selected (Executable name _ _) = selected == Just name+ isActiveExe selected (Executable name _ _) = selected == Just (T.pack name) packageRegister :: PackageAction packageRegister = do@@ -487,7 +496,7 @@ let dir = ipdBuildDir package runExternalTool' (__ "Registering") (cabalCommand prefs) (["register"] ++ (ipdRegisterFlags package)) dir $ do- (mbLastOutput, _) <- CU.zipSinks sinkLast (logOutput logLaunch)+ mbLastOutput <- C.getZipSink $ (const <$> C.ZipSink sinkLast) <*> C.ZipSink (logOutput logLaunch) lift $ continuation (mbLastOutput == Just (ToolExit ExitSuccess))) (\(e :: SomeException) -> putStrLn (show e)) else continuation True@@ -508,8 +517,10 @@ let dir = ipdBuildDir package runExternalTool' (__ "Testing") (cabalCommand prefs) (["test"] ++ ipdBuildFlags package ++ ipdTestFlags package) dir $ do- (mbLastOutput, (isConfigErr, _)) <- CU.zipSinks sinkLast $ CU.zipSinks isConfigError $- logOutputForBuild package False True+ (mbLastOutput, isConfigErr, _) <- C.getZipSink $ (,,)+ <$> C.ZipSink sinkLast+ <*> C.ZipSink isConfigError+ <*> (C.ZipSink $ logOutputForBuild package False True) lift $ do errs <- readIDE errorRefs if shallConfigure && isConfigErr@@ -549,19 +560,19 @@ </> "index.html" dir = ipdBuildDir package #ifdef WEBKITGTK- loadDoc ("file:///" ++ dir </> path)+ loadDoc . T.pack $ "file:///" ++ dir </> path getDocumentation Nothing >>= \ p -> displayPane p False #else- openBrowser path+ openBrowser $ T.pack path #endif `catchIDE` (\(e :: SomeException) -> putStrLn (show e)) runPackage :: (ProcessHandle -> IDEAction)- -> String+ -> Text -> FilePath- -> [String]+ -> [Text] -> FilePath -> C.Sink ToolOutput IDEM () -> IDEAction@@ -585,29 +596,31 @@ pd <- readPackageDescription normal (ipdCabalFile p) return (Just (flattenPackageDescription pd,ipdCabalFile p))) (\(e :: SomeException) -> do- reflectIDE (ideMessage Normal ((__ "Can't load package ") ++(show e))) ideR+ reflectIDE (ideMessage Normal ((__ "Can't load package ") <> T.pack (show e))) ideR return Nothing)) -getEmptyModuleTemplate :: PackageDescription -> String -> IO String+getEmptyModuleTemplate :: PackageDescription -> Text -> IO Text getEmptyModuleTemplate pd modName = getModuleTemplate "module" pd modName "" "" -getModuleTemplate :: String -> PackageDescription -> String -> String -> String -> IO String-getModuleTemplate template pd modName exports body = catch (do+getModuleTemplate :: FilePath -> PackageDescription -> Text -> Text -> Text -> IO Text+getModuleTemplate templateName pd modName exports body = catch (do dataDir <- getDataDir- filePath <- getConfigFilePathForLoad (template ++ leksahTemplateFileExtension) Nothing dataDir- template <- UTF8.readFile filePath- return (foldl' (\ a (from, to) -> replace from to a) template- [ ("@License@" , (display . license) pd)- , ("@Maintainer@" , maintainer pd)- , ("@Stability@" , stability pd)+ filePath <- getConfigFilePathForLoad (templateName <> leksahTemplateFileExtension) Nothing dataDir+ template <- T.readFile filePath+ return (foldl' (\ a (from, to) -> T.replace from to a) template+ [ ("@License@" , (T.pack . display . license) pd)+ , ("@Maintainer@" , T.pack $ maintainer pd)+ , ("@Stability@" , T.pack $ stability pd) , ("@Portability@" , "")- , ("@Copyright@" , copyright pd)+ , ("@Copyright@" , T.pack $ copyright pd) , ("@ModuleName@" , modName) , ("@ModuleExports@", exports) , ("@ModuleBody@" , body)]))- (\ (e :: SomeException) -> sysMessage Normal (printf (__ "Couldn't read template file: %s") (show e)) >> return "")+ (\ (e :: SomeException) -> do+ sysMessage Normal . T.pack $ printf (__ "Couldn't read template file: %s") (show e)+ return "") -data ModuleLocation = LibExposedMod | LibOtherMod | ExeOrTestMod String+data ModuleLocation = LibExposedMod | LibOtherMod | ExeOrTestMod Text addModuleToPackageDescr :: ModuleName -> [ModuleLocation] -> PackageAction addModuleToPackageDescr moduleName locations = do@@ -617,14 +630,14 @@ let npd = trace (show gpd) foldr addModule gpd locations writeGenericPackageDescription (ipdCabalFile p) npd) (\(e :: SomeException) -> do- reflectIDE (ideMessage Normal ((__ "Can't update package ") ++ show e)) ideR+ reflectIDE (ideMessage Normal ((__ "Can't update package ") <> T.pack (show e))) ideR return ())) where addModule LibExposedMod gpd@GenericPackageDescription{condLibrary = Just lib} = gpd {condLibrary = Just (addModToLib moduleName lib)} addModule LibOtherMod gpd@GenericPackageDescription{condLibrary = Just lib} = gpd {condLibrary = Just (addModToBuildInfoLib moduleName lib)}- addModule (ExeOrTestMod name) gpd = gpd {+ addModule (ExeOrTestMod name') gpd = let name = T.unpack name' in gpd { condExecutables = map (addModToBuildInfoExe name moduleName) (condExecutables gpd) , condTestSuites = map (addModToBuildInfoTest name moduleName) (condTestSuites gpd) }@@ -680,7 +693,7 @@ (condExecutables gpd)} writeGenericPackageDescription (ipdCabalFile p) npd) (\(e :: SomeException) -> do- reflectIDE (ideMessage Normal ((__ "Can't update package ") ++ show e)) ideR+ reflectIDE (ideMessage Normal ((__ "Can't update package ") <> T.pack (show e))) ideR return ())) delModFromLib :: ModuleName -> CondTree ConfVar [Dependency] Library ->@@ -723,22 +736,22 @@ -- | * Debug code that needs to use the package -- -interactiveFlag :: String -> Bool -> String-interactiveFlag name f = (if f then "-f" else "-fno-") ++ name+interactiveFlag :: Text -> Bool -> Text+interactiveFlag name f = (if f then "-f" else "-fno-") <> name -printEvldWithShowFlag :: Bool -> String+printEvldWithShowFlag :: Bool -> Text printEvldWithShowFlag = interactiveFlag "print-evld-with-show" -breakOnExceptionFlag :: Bool -> String+breakOnExceptionFlag :: Bool -> Text breakOnExceptionFlag = interactiveFlag "break-on-exception" -breakOnErrorFlag :: Bool -> String+breakOnErrorFlag :: Bool -> Text breakOnErrorFlag = interactiveFlag "break-on-error" -printBindResultFlag :: Bool -> String+printBindResultFlag :: Bool -> Text printBindResultFlag = interactiveFlag "print-bind-result" -interactiveFlags :: Prefs -> [String]+interactiveFlags :: Prefs -> [Text] interactiveFlags prefs = (printEvldWithShowFlag $ printEvldWithShow prefs) : (breakOnExceptionFlag $ breakOnException prefs)@@ -823,7 +836,7 @@ _ -> do return () -executeDebugCommand :: String -> (C.Sink ToolOutput IDEM ()) -> DebugAction+executeDebugCommand :: Text -> (C.Sink ToolOutput IDEM ()) -> DebugAction executeDebugCommand command handler = do (_, ghci) <- ask lift $ do@@ -851,7 +864,7 @@ pd <- readPackageDescription normal ipdCabalFile return (Just (flattenPackageDescription pd))) (\ (e :: SomeException) -> do- reflectIDE (ideMessage Normal ((__ "Can't activate package ") ++(show e))) ideR+ reflectIDE (ideMessage Normal ((__ "Can't activate package ") <> T.pack (show e))) ideR return Nothing)) case mbPackageD of Nothing -> return Nothing@@ -866,12 +879,12 @@ ipdSrcDirs = case (nub $ concatMap hsSourceDirs (allBuildInfo' packageD)) of [] -> [".","src"] l -> l- ipdExes = [ exeName e | e <- executables packageD+ ipdExes = [ T.pack $ exeName e | e <- executables packageD , buildable (buildInfo e) ] ipdExtensions = nub $ concatMap oldExtensions (allBuildInfo' packageD)- ipdTests = [ testName t | t <- testSuites packageD+ ipdTests = [ T.pack $ testName t | t <- testSuites packageD , buildable (testBuildInfo t) ]- ipdBenchmarks = [ benchmarkName b | b <- benchmarks packageD+ ipdBenchmarks = [ T.pack $ benchmarkName b | b <- benchmarks packageD , buildable (benchmarkBuildInfo b) ] ipdPackageId = package packageD ipdDepends = buildDepends packageD
src/IDE/Pane/Breakpoints.hs view
@@ -1,5 +1,8 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances,- MultiParamTypeClasses, DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Breakpoints@@ -36,7 +39,7 @@ import Data.List (elemIndex) import Control.Monad.IO.Class (MonadIO(..)) import IDE.Utils.GUIUtils (treeViewContextMenu, __)-import qualified Data.Text as T (unpack)+import qualified Data.Text as T (words, unpack) -- | A breakpoints pane description@@ -88,7 +91,7 @@ treeViewAppendColumn treeView colB cellLayoutPackStart colB rendererB False cellLayoutSetAttributes colB rendererB breakpoints- $ \row -> [ cellText := T.unpack $ refDescription row]+ $ \row -> [ cellText := refDescription row] treeViewSetHeadersVisible treeView True selB <- treeViewGetSelection treeView@@ -183,7 +186,7 @@ deleteBreakpoint :: LogRef -> IDEAction deleteBreakpoint logRef = case logRefType logRef of- BreakpointRef -> debugDeleteBreakpoint (words (T.unpack $ refDescription logRef) !! 1) logRef+ BreakpointRef -> debugDeleteBreakpoint (T.words (refDescription logRef) !! 1) logRef _ -> sysMessage Normal (__ "Debugger>>deleteBreakpoint: Not a breakpoint")
src/IDE/Pane/Errors.hs view
@@ -88,7 +88,7 @@ $ \row -> [cellText := if index row == 0 then showSourceSpan (logRef row) else "", cellTextForeground := if logRefType (logRef row) == WarningRef then "green"- else "red" ]+ else "red"::Text ] rendererB <- cellRendererTextNew colB <- treeViewColumnNew treeViewColumnSetTitle colB (__ "Description")@@ -98,7 +98,7 @@ treeViewAppendColumn treeView colB cellLayoutPackStart colB rendererB False cellLayoutSetAttributes colB rendererB errorStore- $ \row -> [ cellText := T.unpack $ text row]+ $ \row -> [ cellText := text row] treeViewSetHeadersVisible treeView True selB <- treeViewGetSelection treeView
src/IDE/Pane/Files.hs view
@@ -1,5 +1,10 @@-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses,- TypeSynonymInstances, RecordWildCards, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Files@@ -45,7 +50,7 @@ workspace, readIDE, IDEAction, ideMessage, reflectIDE, reifyIDE, IDEM, IDEPackage, ipdSandboxSources) import IDE.Pane.SourceBuffer- (goToSourceDefinition)+ (goToSourceDefinition') import Control.Applicative ((<$>)) import System.FilePath ((</>), takeFileName, dropFileName) import Distribution.Package (PackageIdentifier(..))@@ -63,6 +68,9 @@ import Control.Monad.IO.Class (MonadIO(..)) import IDE.Utils.GUIUtils (__) import Control.Exception (catch)+import Data.Text (Text)+import qualified Data.Text as T (pack)+import Data.Monoid ((<>)) data FileRecord = FileRecord FilePath@@ -70,10 +78,10 @@ | PackageRecord IDEPackage | PlaceHolder deriving(Eq) -file :: FileRecord -> String-file (FileRecord f) = takeFileName f-file (DirRecord f) = takeFileName f-file (PackageRecord p) = packageIdentifierToString (ipdPackageId p) ++ " " ++ ipdBuildDir p+file :: FileRecord -> Text+file (FileRecord f) = T.pack $ takeFileName f+file (DirRecord f) = T.pack $ takeFileName f+file (PackageRecord p) = packageIdentifierToString (ipdPackageId p) <> " " <> T.pack (ipdBuildDir p) file PlaceHolder = "" -- | A files pane description@@ -143,7 +151,7 @@ record <- treeStoreGetValue fileStore path reflectIDE ( case record of- FileRecord f -> void (goToSourceDefinition f (Just $ Location 1 0 1 0))+ FileRecord f -> void (goToSourceDefinition' f (Location "" 1 0 1 0)) DirRecord f -> liftIO $ refreshDir fileStore path f PackageRecord p -> liftIO $ refreshPackage fileStore path p _ -> ideMessage Normal (__ "Unexpected Activation in Files Pane")) ideR
src/IDE/Pane/Grep.hs view
@@ -1,10 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Grep@@ -60,14 +61,15 @@ import Control.Monad.IO.Class (MonadIO(..)) import IDE.Utils.GUIUtils (__) import System.Directory (getDirectoryContents)-import qualified Data.Text as T (unpack)+import qualified Data.Text as T (pack, take, unpack) import System.Log.Logger (debugM) import Control.Exception (SomeException, catch)+import Data.Text (Text) data GrepRecord = GrepRecord { file :: FilePath , line :: Int- , context :: String+ , context :: Text , parDir :: Maybe FilePath } @@ -115,7 +117,7 @@ treeViewAppendColumn treeView col1 cellLayoutPackStart col1 renderer1 True cellLayoutSetAttributes col1 renderer1 grepStore- $ \row -> [ cellText := file row]+ $ \row -> [ cellText := T.pack $ file row] renderer2 <- cellRendererTextNew col2 <- treeViewColumnNew@@ -126,7 +128,7 @@ treeViewAppendColumn treeView col2 cellLayoutPackStart col2 renderer2 True cellLayoutSetAttributes col2 renderer2 grepStore- $ \row -> [ cellText := show $ line row]+ $ \row -> [ cellText := T.pack $ show $ line row] renderer3 <- cellRendererTextNew col3 <- treeViewColumnNew@@ -137,7 +139,7 @@ treeViewAppendColumn treeView col3 cellLayoutPackStart col3 renderer3 True cellLayoutSetAttributes col3 renderer3 grepStore- $ \row -> [ cellText := take 2048 $ context row]+ $ \row -> [ cellText := T.take 2048 $ context row] treeViewSetHeadersVisible treeView True@@ -160,7 +162,7 @@ Just record -> reflectIDE (do case record of GrepRecord {file=f, line=l, parDir=Just pp} ->- (goToSourceDefinition (pp </> f) $ Just $ Location l 0 l 0)+ (goToSourceDefinition pp $ Location f l 0 l 0) ?>>= (\(IDEBuffer {sourceView = sv}) -> when focus $ grabFocus sv) _ -> return ()) ideR Nothing -> return ()@@ -197,7 +199,7 @@ char ':' line <- int char ':'- context <- many anyChar+ context <- T.pack <$> many anyChar let parDir = Nothing return $ GrepRecord {..} <?> "grepLineParser")@@ -222,7 +224,7 @@ _ -> return Nothing --TODO srp use default loglaunch probably-grepWorkspace :: String -> Bool -> WorkspaceAction+grepWorkspace :: Text -> Bool -> WorkspaceAction grepWorkspace "" caseSensitive = return () grepWorkspace regexString caseSensitive = do ws <- ask@@ -233,7 +235,7 @@ lift $ grepDirectories regexString caseSensitive $ map (\p -> (dropFileName $ ipdCabalFile p)) $ packages -grepDirectories :: String -> Bool -> [FilePath] -> IDEAction+grepDirectories :: Text -> Bool -> [FilePath] -> IDEAction grepDirectories regexString caseSensitive dirs = do grep <- getGrep Nothing let store = grepStore grep@@ -261,7 +263,7 @@ "--exclude-dir=_darcs", "--exclude-dir=.git", #endif- regexString] ++ subDirs) (Just dir)+ regexString] ++ map T.pack subDirs) (Just dir) reflectIDE (do output $$ do let max = 1000@@ -283,7 +285,7 @@ nooneWaiting <- isEmptyMVar (waitingGrep grep) when nooneWaiting $ postGUISync $ do nDir <- treeModelIterNChildren store Nothing- treeStoreInsert store [] nDir $ GrepRecord (__ "Search Complete") totalFound "" Nothing+ treeStoreInsert store [] nDir $ GrepRecord (T.unpack $ __ "Search Complete") totalFound "" Nothing takeMVar (activeGrep grep) >> return () return ()
src/IDE/Pane/HLint.hs view
@@ -1,6 +1,9 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses,- TypeSynonymInstances, RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.HLint@@ -34,7 +37,7 @@ import IDE.BufferMode import IDE.LogRef (logOutput, defaultLineLogger) import IDE.Pane.SourceBuffer- (goToSourceDefinition, maybeActiveBuf, IDEBuffer(..), replaceHLintSource)+ (goToSourceDefinition', maybeActiveBuf, IDEBuffer(..), replaceHLintSource) import IDE.TextEditor (grabFocus) import Control.Applicative ((<$>)) import System.FilePath ((</>), dropFileName)@@ -57,10 +60,14 @@ import IDE.Metainfo.Provider (getWorkspaceInfo) import qualified Data.Map as Map (keys, lookup) import Distribution.Package (PackageIdentifier(..))+import Data.Text (Text)+import qualified Data.Text as T+ (replicate, unlines, init, lines, pack, unpack)+import Data.Monoid ((<>)) data HLintRecord = HLintRecord { condPackage :: Maybe IDEPackage- , context :: String+ , context :: Text , condIdea :: Maybe H.Idea , parDir :: Maybe FilePath } deriving (Eq)@@ -218,8 +225,8 @@ Just record -> case record of HLintRecord {condIdea = Just idea} ->- goToSourceDefinition (srcSpanFilename (H.ideaSpan idea))- (Just $ Location (srcSpanStartLine (H.ideaSpan idea))+ goToSourceDefinition' (srcSpanFilename (H.ideaSpan idea))+ (Location "" (srcSpanStartLine (H.ideaSpan idea)) (srcSpanStartColumn (H.ideaSpan idea)) (srcSpanEndLine (H.ideaSpan idea)) (srcSpanEndColumn (H.ideaSpan idea)))@@ -255,7 +262,7 @@ " location " ++ show H.parseErrorLocation) Nothing Right r -> Just r) resL let ideas = H.applyHints classify hint resOk- liftIO $ setHLint2Results store iter (packageIdentifierToString (ipdPackageId package)) ideas+ liftIO $ setHLint2Results store iter (T.unpack $ packageIdentifierToString (ipdPackageId package)) ideas return () @@ -279,7 +286,7 @@ hlint2Record dir idea = HLintRecord { condPackage = Nothing,- context = show idea,+ context = T.pack $ show idea, condIdea = Just idea, parDir = Just dir} @@ -319,10 +326,10 @@ replaceHlint store treeView (Just sel) = case condIdea sel of Just idea | isJust (H.ideaTo idea) ->- let lined = lines (fromJust (H.ideaTo idea))+ let lined = T.lines (T.pack $ fromJust (H.ideaTo idea)) startColumn = srcSpanStartColumn (H.ideaSpan idea)- source = init $ unlines (head lined :- map (\ s -> replicate startColumn ' ' ++ s) (tail lined))+ source = T.init $ T.unlines (head lined :+ map (\ s -> T.replicate startColumn " " <> s) (tail lined)) in replaceHLintSource (srcSpanFilename (H.ideaSpan idea)) (srcSpanStartLine (H.ideaSpan idea))
src/IDE/Pane/Info.hs view
@@ -1,5 +1,10 @@-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses,- CPP, ScopedTypeVariables, TypeSynonymInstances, GADTs, RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fwarn-unused-imports #-} ----------------------------------------------------------------------------- --@@ -45,6 +50,8 @@ import System.Glib.Signals (on) import Control.Monad (void, when) import Data.Foldable (forM_)+import qualified Data.Text as T (unpack, pack, null)+import Data.Monoid ((<>)) -- | An info pane description --@@ -88,7 +95,7 @@ createHyperLinkSupport descriptionView sw (\_ _ iter -> do (beg, en) <- getIdentifierUnderCursorFromIter (iter, iter) return (beg, en)) (\_ shift' slice ->- when (slice /= []) $ do+ when (not $ T.null slice) $ do -- liftIO$ print ("slice",slice) triggerEventIDE (SelectInfo slice shift') return ()@@ -140,7 +147,7 @@ oldDescr <- liftIO $ readIORef (currentDescr info) liftIO $ writeIORef (currentDescr info) (Just identifierDescr) tb <- getBuffer v- setText tb (show (Present identifierDescr) ++ "\n") -- EOL for text iters to work+ setText tb (T.pack $ show (Present identifierDescr) ++ "\n") -- EOL for text iters to work recordInfoHistory (Just identifierDescr) oldDescr setInfoStyle :: IDEAction@@ -182,7 +189,7 @@ Nothing -> return () Just descr -> do prefs' <- readIDE prefs- openBrowser $ docuSearchURL prefs' ++ escapeURIString isAlphaNum (dscName descr)+ openBrowser $ docuSearchURL prefs' <> T.pack (escapeURIString isAlphaNum (T.unpack $ dscName descr)) populatePopupMenu :: IDERef -> IORef (Maybe Descr) -> Menu -> IO () populatePopupMenu ideR currentDescr' menu = do
src/IDE/Pane/Log.hs view
@@ -1,5 +1,9 @@-{-# LANGUAGE FlexibleInstances, ScopedTypeVariables,- DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} -- -- Module : IDE.Pane.Log -- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie@@ -21,7 +25,7 @@ , showLog , clearLog , getLog -- :: beta alpha-, appendLog -- :: alpha -> String -> LogTag -> IO Int+, appendLog -- :: alpha -> Text -> LogTag -> IO Int , markErrorInLog -- :: alpha -> (Int, Int) -> IO () , getActiveOrDefaultLogLaunch , getDefaultLogLaunch@@ -79,8 +83,10 @@ import IDE.Utils.GUIUtils (__) import Text.Printf (printf) import Data.Text (Text)-import qualified Data.Text as T (length, unpack)-import Data.Monoid ((<>))+import qualified Data.Text as T+ (null, all, drop, tail, init, take, reverse, isSuffixOf,+ isPrefixOf, pack, length, unpack)+import Data.Monoid (Monoid(..), (<>)) import Data.List (elemIndex, isPrefixOf, isSuffixOf, findIndex) import Data.Foldable (forM_) @@ -117,19 +123,19 @@ return $ logLaunch $ launches Map.! defaultLogName buildLogLaunchByPackage :: IDEPackage- -> IDEM (LogLaunch, String)+ -> IDEM (LogLaunch, Text) buildLogLaunchByPackage = buildLogLaunchByShownPackageId . getLogLaunchNameByPackage buildLogLaunchByPackageId :: PackageIdentifier- -> IDEM (LogLaunch, String)+ -> IDEM (LogLaunch, Text) buildLogLaunchByPackageId = buildLogLaunchByShownPackageId . getLogLaunchNameByPackageId -buildLogLaunchByShownPackageId :: String- -> IDEM (LogLaunch, String)+buildLogLaunchByShownPackageId :: Text+ -> IDEM (LogLaunch, Text) buildLogLaunchByShownPackageId = buildLogLaunchByName -buildLogLaunchByName :: String- -> IDEM (LogLaunch, String)+buildLogLaunchByName :: Text+ -> IDEM (LogLaunch, Text) buildLogLaunchByName logName = do log <- getLog launches <- readIDE logLaunches@@ -144,31 +150,29 @@ incrementName name = case parseName name of Nothing -> createNewName name 0 Just (number,name) -> createNewName name number- createNewName name number = concat [name, " (", show (number+1), ")"]+ createNewName name number = mconcat [name, " (", T.pack (show $ number+1), ")"] parseName name = if surroundedByParenth (getLaunchString name) &&- isNumberAndNotEmpty (init $ tail $ getLaunchString name)+ isNumberAndNotEmpty (T.init $ T.tail $ getLaunchString name) then Just- (read $ init $ tail $ getLaunchString name,- reverse $ drop 4 $ reverse name)+ (read $ T.unpack $ T.init $ T.tail $ getLaunchString name,+ T.reverse $ T.drop 4 $ T.reverse name) else Nothing- surroundedByParenth string = ("(" `isPrefixOf` string ) && (")" `isSuffixOf` string) && isNotBlank string- isNumberAndNotEmpty string = all isNumber string && isNotBlank string -- check if- getLaunchString name = reverse $ take 3 $ reverse name- isNotBlank [] = False- isNotBlank _ = True+ surroundedByParenth string = ("(" `T.isPrefixOf` string ) && (")" `T.isSuffixOf` string) && not (T.null string)+ isNumberAndNotEmpty string = T.all isNumber string && not (T.null string) -- check if+ getLaunchString name = T.reverse $ T.take 3 $ T.reverse name -getLogLaunchNameByPackage :: IDEPackage -> String+getLogLaunchNameByPackage :: IDEPackage -> Text getLogLaunchNameByPackage package = getLogLaunchNameByPackageId (ipdPackageId package) -getLogLaunchNameByPackageId :: PackageIdentifier -> String-getLogLaunchNameByPackageId (PackageIdentifier pkgName pkgVersion) = show pkgName ++ show pkgVersion+getLogLaunchNameByPackageId :: PackageIdentifier -> Text+getLogLaunchNameByPackageId (PackageIdentifier pkgName pkgVersion) = T.pack $ show pkgName ++ show pkgVersion defaultLogName = "default" -- ^ adds arguments to ide to process them later. -- ^ e.g. using processhandle to kill process and name to switch between view-addLogLaunchData :: String -> LogLaunch -> ProcessHandle -> IDEM ()+addLogLaunchData :: Text -> LogLaunch -> ProcessHandle -> IDEM () addLogLaunchData name logLaunch pid = do log <- getLog let comboBox = logLaunchBox log@@ -214,9 +218,9 @@ liftIO $ showDefaultLogLaunch comboBox -showLogLaunch :: String -> IDEM ()+showLogLaunch :: Text -> IDEM () showLogLaunch name = do- liftIO $ putStrLn $ "showLogLaunch: name = " ++ name+ liftIO $ putStrLn $ "showLogLaunch: name = " <> T.unpack name log <- getLog let comboBox = logLaunchBox log @@ -266,23 +270,23 @@ tags <- textBufferGetTagTable buf errtag <- textTagNew (Just "err")- set errtag[textTagForeground := "red"]+ set errtag[textTagForeground := ("red" :: Text)] textTagTableAdd tags errtag frametag <- textTagNew (Just "frame")- set frametag[textTagForeground := "dark green"]+ set frametag[textTagForeground := ("dark green" :: Text)] textTagTableAdd tags frametag activeErrtag <- textTagNew (Just "activeErr")- set activeErrtag[textTagBackground := "yellow"]+ set activeErrtag[textTagBackground := ("yellow" :: Text)] textTagTableAdd tags activeErrtag intputTag <- textTagNew (Just "input")- set intputTag[textTagForeground := "blue"]+ set intputTag[textTagForeground := ("blue" :: Text)] textTagTableAdd tags intputTag infoTag <- textTagNew (Just "info")- set infoTag[textTagForeground := "grey"]+ set infoTag[textTagForeground := ("grey" :: Text)] textTagTableAdd tags infoTag return $ LogLaunch buf@@ -294,7 +298,7 @@ builder' pp nb windows = do prefs <- readIDE prefs newLogLaunch <- liftIO createNewLogLaunch- let emptyMap = Map.empty :: Map.Map String LogLaunchData+ let emptyMap = Map.empty :: Map.Map Text LogLaunchData let map = Map.insert defaultLogName (LogLaunchData newLogLaunch Nothing) emptyMap modifyIDE_ $ \ide -> ide { logLaunches = map} @@ -320,7 +324,7 @@ Just str -> fontDescriptionFromString str Nothing -> do f <- fontDescriptionNew- fontDescriptionSetFamily f "Sans"+ fontDescriptionSetFamily f ("Sans" :: Text) return f widgetModifyFont tv (Just fd) sw <- scrolledWindowNew Nothing Nothing@@ -467,7 +471,7 @@ let buf = logBuffer logLaunch iter <- textBufferGetEndIter buf textBufferSelectRange buf iter iter- textBufferInsert buf iter (T.unpack text)+ textBufferInsert buf iter text iter2 <- textBufferGetEndIter buf let tagName = case tag of LogTag -> Nothing@@ -512,7 +516,7 @@ clearLog = do log <- getLog buf <- liftIO $ textViewGetBuffer $ logLaunchTextView log- liftIO $ textBufferSetText buf ""+ liftIO $ textBufferSetText buf ("" :: Text) -- modifyIDE_ (\ide -> ide{allLogRefs = []}) -- setCurrentError Nothing -- setCurrentBreak Nothing TODO: Check with Hamish
src/IDE/Pane/Modules.hs view
@@ -1,5 +1,10 @@-{-# LANGUAGE CPP, FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses,- ScopedTypeVariables, TypeSynonymInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Modules@@ -48,6 +53,7 @@ import Distribution.Text (simpleParse,display) import Data.Typeable (Typeable(..)) import Control.Exception (SomeException(..),catch)+import Control.Applicative ((<$>)) import IDE.Package (packageConfig,addModuleToPackageDescr,delModuleFromPackageDescr,getEmptyModuleTemplate,getPackageDescriptionAndPath, ModuleLocation(..)) import Distribution.PackageDescription (allBuildInfo, hsSourceDirs, hasLibs, executables, testSuites, exeName, testName,@@ -58,7 +64,8 @@ import Graphics.UI.Editor.Parameters (paraMinSize, paraMultiSel, Parameter(..), emptyParams, (<<<-), paraName)-import Graphics.UI.Editor.Simple (boolEditor,staticListEditor,stringEditor)+import Graphics.UI.Editor.Simple+ (textEditor, boolEditor, staticListEditor) import Graphics.UI.Editor.Composite (maybeEditor) import qualified System.IO.UTF8 as UTF8 (writeFile) import IDE.Utils.GUIUtils (stockIdFromType, __)@@ -68,21 +75,31 @@ import Default (Default(..)) import IDE.Workspaces (packageTry) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (when)+import Control.Monad (when, void) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Reader (ask) import IDE.Utils.GUIUtils (treeViewContextMenu) import System.Glib.Properties (newAttrFromMaybeStringProperty)-import Text.Printf (printf)+import Data.Text (Text)+import qualified Data.Text as T (unpack, isInfixOf, toLower, pack)+import Data.Monoid ((<>))+import qualified Text.Printf as S (printf)+import Text.Printf (PrintfType)+import qualified Data.Text.IO as T (writeFile) +printf :: PrintfType r => Text -> r+printf = S.printf . T.unpack+ -- | A modules pane description -- +type ModuleRecord = (Text, Maybe (ModuleDescr,PackageDescr))+ data IDEModules = IDEModules { outer :: VBox , paned :: HPaned , treeView :: TreeView-, treeStore :: TreeStore (String, Maybe (ModuleDescr,PackageDescr))+, treeStore :: TreeStore ModuleRecord , descrView :: TreeView , descrStore :: TreeStore Descr , packageScopeB :: RadioButton@@ -96,7 +113,7 @@ data ModulesState = ModulesState Int (Scope,Bool)- (Maybe ModuleName, Maybe String) ExpanderState+ (Maybe ModuleName, Maybe Text) ExpanderState deriving(Eq,Ord,Read,Show,Typeable) data ExpanderState = ExpanderState {@@ -116,7 +133,7 @@ data SelectionState = SelectionState { moduleS' :: Maybe ModuleName-, facetS' :: Maybe String+, facetS' :: Maybe Text , scope' :: Scope , blacklist' :: Bool} deriving (Eq,Ord,Show)@@ -179,7 +196,7 @@ --treeViewSetRulesHint treeView True renderer0 <- cellRendererPixbufNew- set renderer0 [ newAttrFromMaybeStringProperty "stock-id" := Nothing ]+ set renderer0 [ newAttrFromMaybeStringProperty "stock-id" := (Nothing :: Maybe Text) ] renderer <- cellRendererTextNew col <- treeViewColumnNew@@ -198,7 +215,7 @@ case snd row of Nothing -> Nothing Just pair -> if isJust (mdMbSourcePath (fst pair))- then Just "ide_source"+ then Just ("ide_source" :: Text) else Nothing] renderer2 <- cellRendererTextNew@@ -213,7 +230,7 @@ $ \row -> [ cellText := case snd row of Nothing -> ""- Just pair -> (display . pdPackage . snd) pair]+ Just pair -> (T.pack . display . pdPackage . snd) pair] treeViewSetHeadersVisible treeView True treeViewSetEnableSearch treeView True@@ -246,7 +263,7 @@ else if isJust (dscMbLocation row) then if dscExported row- then "ide_source"+ then ("ide_source" :: Text) else "ide_source_local" else "ide_empty"] treeViewSetHeadersVisible descrView True@@ -366,9 +383,9 @@ else (False, False) -selectIdentifier' :: ModuleName -> String -> IDEAction+selectIdentifier' :: ModuleName -> Text -> IDEAction selectIdentifier' moduleName symbol =- let nameArray = components moduleName+ let nameArray = map T.pack $ components moduleName in do liftIO $ debugM "leksah" "selectIdentifier'" mods <- getModules Nothing@@ -392,7 +409,7 @@ bringPaneToFront mods Nothing -> return () -findPathFor :: String -> Maybe (Tree Descr) -> Maybe TreePath+findPathFor :: Text -> Maybe (Tree Descr) -> Maybe TreePath findPathFor symbol (Just (Node _ forest)) = foldr ( \i mbTreePath -> findPathFor' [i] (forest !! i) mbTreePath) Nothing [0 .. ((length forest) - 1)]@@ -407,7 +424,7 @@ Nothing [0 .. ((length sub) - 1)] findPathFor symbol Nothing = Nothing -treePathFromNameArray :: Maybe ModTree -> [String] -> [Int] -> Maybe [Int]+treePathFromNameArray :: Maybe ModTree -> [Text] -> [Int] -> Maybe [Int] treePathFromNameArray (Just tree) [] accu = Just (reverse accu) treePathFromNameArray (Just tree) (h:t) accu = let names = map (\t -> fst $ rootLabel t) (subForest tree)@@ -418,8 +435,8 @@ treePathFromNameArray Nothing _ _ = Nothing treeViewSearch :: TreeView- -> TreeStore (String, Maybe (ModuleDescr,PackageDescr))- -> String+ -> TreeStore ModuleRecord+ -> Text -> TreeIter -> IO Bool treeViewSearch treeView treeStore string iter = do@@ -436,23 +453,23 @@ let str2 = case snd val of Just (mod,_) -> showPackModule (mdModuleId mod) Nothing -> ""- let res = isInfixOf (map toLower string) (map toLower str2)+ let res = T.isInfixOf (T.toLower string) (T.toLower str2) return res -searchInModSubnodes :: ModTree -> String -> Bool+searchInModSubnodes :: ModTree -> Text -> Bool searchInModSubnodes tree str = not $ null $ filter (\ (_,mbPair) -> case mbPair of Nothing -> False Just (mod,_) ->- let cstr = show (Present (mdModuleId mod))- in isInfixOf (map toLower str) (map toLower cstr))+ let cstr = T.pack $ show (Present (mdModuleId mod))+ in T.isInfixOf (T.toLower str) (T.toLower cstr)) $ concatMap flatten (subForest tree) descrViewSearch :: TreeView -> TreeStore Descr- -> String+ -> Text -> TreeIter -> IO Bool descrViewSearch descrView descrStore string iter = do@@ -466,17 +483,17 @@ in when found $ do treeViewExpandRow descrView path False return ()- return (isInfixOf (map toLower string) (map toLower (descrTreeText val)))+ return (T.isInfixOf (T.toLower string) (T.toLower (descrTreeText val))) -searchInFacetSubnodes :: DescrTree -> String -> Bool+searchInFacetSubnodes :: DescrTree -> Text -> Bool searchInFacetSubnodes tree str = not $ null $ filter (\ val ->- isInfixOf (map toLower str) (map toLower (descrTreeText val)))+ T.isInfixOf (T.toLower str) (T.toLower (descrTreeText val))) $ concatMap flatten (subForest tree) fillFacets :: TreeView- -> TreeStore (String, Maybe (ModuleDescr,PackageDescr))+ -> TreeStore ModuleRecord -> TreeView -> TreeStore Descr -> IO ()@@ -498,8 +515,8 @@ -> treeStoreClear descrStore getSelectionTree :: TreeView- -> TreeStore (String, Maybe (ModuleDescr,PackageDescr))- -> IO (Maybe (String, Maybe (ModuleDescr,PackageDescr)))+ -> TreeStore ModuleRecord+ -> IO (Maybe ModuleRecord) getSelectionTree treeView treeStore = do liftIO $ debugM "leksah" "getSelectionTree" treeSelection <- treeViewGetSelection treeView@@ -540,7 +557,7 @@ return () _ -> return () -findDescription :: SymbolTable alpha => PackModule -> alpha -> String -> Maybe (String,Descr)+findDescription :: SymbolTable alpha => PackModule -> alpha -> Text -> Maybe (Text,Descr) findDescription md st s = case filter (\id -> case dsMbModu id of Nothing -> False@@ -548,7 +565,7 @@ [] -> Nothing l -> Just (s,head l) -getEmptyDefaultScope :: Map String [Descr]+getEmptyDefaultScope :: Map Text [Descr] getEmptyDefaultScope = Map.empty fillModulesList :: (Scope,Bool) -> IDEAction@@ -625,12 +642,12 @@ type DescrTree = Tree Descr -descrTreeText :: Descr -> String-descrTreeText (Real (RealDescr id _ _ _ _ (InstanceDescr binds) _)) = id ++ " " ++ printBinds binds+descrTreeText :: Descr -> Text+descrTreeText (Real (RealDescr id _ _ _ _ (InstanceDescr binds) _)) = id <> " " <> printBinds binds where printBinds [] = "" printBinds (a:[]) = a- printBinds (a:b) = a ++ " " ++ printBinds b+ printBinds (a:b) = a <> " " <> printBinds b descrTreeText d = dscName d descrIdType :: Descr -> DescrType@@ -717,10 +734,10 @@ matches _ node (forest,b) = (node:forest,b) -defaultRoot :: Tree (String, Maybe (ModuleDescr,PackageDescr))+defaultRoot :: Tree ModuleRecord defaultRoot = Node ("",Just (getDefault,getDefault)) [] -type ModTree = Tree (String, Maybe (ModuleDescr,PackageDescr))+type ModTree = Tree ModuleRecord -- -- | Make a Tree with a module desription, package description pairs tree to display. -- Their are nodes with a label but without a module (like e.g. Data).@@ -734,13 +751,13 @@ insertPairsInTree :: ModTree -> (ModuleDescr,PackageDescr) -> ModTree insertPairsInTree tree pair =- let nameArray = components $ modu $ mdModuleId $ fst pair+ let nameArray = map T.pack . components . modu . mdModuleId $ fst pair (startArray,last) = splitAt (length nameArray - 1) nameArray pairedWith = (map (\n -> (n,Nothing)) startArray) ++ [(head last,Just pair)] in insertNodesInTree pairedWith tree -insertNodesInTree :: [(String, Maybe (ModuleDescr,PackageDescr))] -> ModTree -> ModTree+insertNodesInTree :: [ModuleRecord] -> ModTree -> ModTree insertNodesInTree [p1@(str1,Just pair)] (Node p2@(str2,mbPair) forest2) = case partition (\ (Node (s,_) _) -> s == str1) forest2 of ([found],rest) -> case found of@@ -762,10 +779,10 @@ (found,rest) -> Node p (insertNodesInTree tl (head found) : tail found ++ rest) insertNodesInTree [] n = n-insertNodesInTree _ _ = error (__ "Modules>>insertNodesInTree: Should not happen2")+insertNodesInTree _ _ = error (T.unpack $ __ "Modules>>insertNodesInTree: Should not happen2") -makeNodes :: [(String,Maybe (ModuleDescr,PackageDescr))] -> ModTree+makeNodes :: [(Text,Maybe (ModuleDescr,PackageDescr))] -> ModTree makeNodes [(str,mbPair)] = Node (str,mbPair) [] makeNodes ((str,mbPair):tl) = Node (str,mbPair) [makeNodes tl] makeNodes _ = throwIDE (__ "Impossible in makeNodes")@@ -776,8 +793,17 @@ sortTree :: Ord a => Tree a -> Tree a sortTree (Node l forest) = Node l (sort (map sortTree forest)) +getSelectedModuleFile :: Maybe ModuleRecord -> Maybe FilePath+getSelectedModuleFile sel =+ case sel of+ Just (_,Just (m,p)) -> case (mdMbSourcePath m, pdMbSourcePath p) of+ (Just fp, Just pp) -> Just $ dropFileName pp </> fp+ (Just fp, Nothing) -> Just fp+ _ -> Nothing+ otherwise -> Nothing+ modulesContextMenu :: IDERef- -> TreeStore (String, Maybe (ModuleDescr,PackageDescr))+ -> TreeStore ModuleRecord -> TreeView -> Menu -> IO ()@@ -785,14 +811,10 @@ liftIO $ debugM "leksah" "modulesContextMenu" item1 <- menuItemNewWithLabel (__ "Edit source") item1 `on` menuItemActivate $ do- sel <- getSelectionTree treeView store- case sel of- Just (_,Just (m,_)) -> case mdMbSourcePath m of- Nothing -> return ()- Just fp -> do- reflectIDE (selectSourceBuf fp) ideR- return ()- otherwise -> return ()+ mbFile <- getSelectedModuleFile <$> getSelectionTree treeView store+ case mbFile of+ Nothing -> return ()+ Just fp -> void $ reflectIDE (selectSourceBuf fp) ideR sep1 <- separatorMenuItemNew item2 <- menuItemNewWithLabel (__ "Expand here") item2 `on` menuItemActivate $ expandHere treeView@@ -807,24 +829,22 @@ item6 `on` menuItemActivate $ reflectIDE (packageTry $ addModule' treeView store) ideR item7 <- menuItemNewWithLabel (__ "Delete module") item7 `on` menuItemActivate $ do- sel <- getSelectionTree treeView store- case sel of- Just (_,Just (m,_)) -> case mdMbSourcePath m of- Nothing -> return ()- Just fp -> do- resp <- reflectIDE (respDelModDialog)ideR- if (resp == False) then return ()- else do- exists <- doesFileExist fp- if exists- then do- reflectIDE (liftIO $ removeFile fp) ideR- reflectIDE (packageTry $ delModule treeView store)ideR- else do- reflectIDE (packageTry $ delModule treeView store)ideR- reflectIDE (packageTry packageConfig) ideR- return ()- otherwise -> return ()+ mbFile <- getSelectedModuleFile <$> getSelectionTree treeView store+ case mbFile of+ Nothing -> return ()+ Just fp -> do+ resp <- reflectIDE (respDelModDialog)ideR+ if (resp == False) then return ()+ else do+ exists <- doesFileExist fp+ if exists+ then do+ reflectIDE (liftIO $ removeFile fp) ideR+ reflectIDE (packageTry $ delModule treeView store)ideR+ else do+ reflectIDE (packageTry $ delModule treeView store)ideR+ reflectIDE (packageTry packageConfig) ideR+ return () sel <- getSelectionTree treeView store case sel of Just (s, Nothing) -> do@@ -838,7 +858,7 @@ otherwise -> return () modulesSelect :: IDERef- -> TreeStore (String, Maybe (ModuleDescr,PackageDescr))+ -> TreeStore ModuleRecord -> TreeView -> TreePath -> TreeViewColumn@@ -846,13 +866,10 @@ modulesSelect ideR store treeView path _ = do liftIO $ debugM "leksah" "modulesSelect" treeViewExpandRow treeView path False- sel <- treeStoreGetValue store path- case sel of- (_,Just (m,_)) -> do- case mdMbSourcePath m of- Nothing -> return ()- Just fp -> liftIO $ reflectIDE (selectSourceBuf fp) ideR >> return ()- _ -> return ()+ mbFile <- getSelectedModuleFile <$> getSelectionTree treeView store+ case mbFile of+ Nothing -> return ()+ Just fp -> liftIO $ reflectIDE (selectSourceBuf fp) ideR >> return () descrViewContextMenu :: IDERef -> TreeStore Descr@@ -959,7 +976,7 @@ applyExpanderState liftIO $ bringPaneToFront mods -selectNames :: (Maybe ModuleName, Maybe String) -> IDEAction+selectNames :: (Maybe ModuleName, Maybe Text) -> IDEAction selectNames (mbModuleName, mbIdName) = do liftIO $ debugM "leksah" "selectIdentifier" mods <- getModules Nothing@@ -970,7 +987,7 @@ selF <- treeViewGetSelection (descrView mods) treeSelectionUnselectAll selF Just moduleName ->- let nameArray = components moduleName+ let nameArray = map T.pack $ components moduleName in do mbTree <- liftIO $ treeStoreGetTreeSave (treeStore mods) [] case treePathFromNameArray mbTree nameArray [] of@@ -999,7 +1016,7 @@ reloadKeepSelection :: Bool -> IDEAction reloadKeepSelection isInitial = do- liftIO $ debugM "leksah" ((__ ">>>Info Changed!!! ") ++ show isInitial)+ liftIO . debugM "leksah" $ (T.unpack $ __ ">>>Info Changed!!! ") ++ show isInitial mbMod <- getPane case mbMod of Nothing -> return ()@@ -1055,7 +1072,7 @@ [] -> return () (hd:_) -> treeViewCollapseRow treeView hd >> return () -delModule :: TreeView -> TreeStore (String, Maybe (ModuleDescr,PackageDescr)) -> PackageAction+delModule :: TreeView -> TreeStore ModuleRecord -> PackageAction delModule treeview store = do liftIO $ debugM "leksah" "delModule" window <- liftIDE $ getMainWindow@@ -1066,14 +1083,14 @@ (treePath:_) -> liftIO $ mapM (treeStoreGetValue store) $ map (\n -> take n treePath) [1 .. length treePath] - liftIDE $ ideMessage Normal (printf (__ "categories: %s") (show categories))+ liftIDE $ ideMessage Normal (T.pack $ printf (__ "categories: %s") (show categories)) let modPacDescr = snd(last categories) case modPacDescr of Nothing -> liftIDE $ ideMessage Normal (__ "This should never be shown!") Just(md,_) -> do let modName = modu.mdModuleId $ md- liftIDE $ ideMessage Normal ("modName: " ++ (show modName))+ liftIDE $ ideMessage Normal ("modName: " <> T.pack (show modName)) delModuleFromPackageDescr modName respDelModDialog :: IDEM (Bool)@@ -1090,7 +1107,7 @@ return resp return $ resp == ResponseUser 1 -addModule' :: TreeView -> TreeStore (String, Maybe (ModuleDescr,PackageDescr)) -> PackageAction+addModule' :: TreeView -> TreeStore ModuleRecord -> PackageAction addModule' treeView store = do liftIO $ debugM "leksah" "addModule'" sel <- liftIO $ treeViewGetSelection treeView@@ -1101,6 +1118,7 @@ $ map (\n -> take n treePath) [1 .. length treePath] addModule categories +addModule :: [ModuleRecord] -> PackageAction addModule categories = do liftIO $ debugM "leksah" "selectIdentifier" mbPD <- liftIDE $ getPackageDescriptionAndPath@@ -1108,29 +1126,31 @@ Nothing -> liftIDE $ ideMessage Normal (__ "No package description") Just (pd,cabalPath) -> let srcPaths = nub $ concatMap hsSourceDirs $ allBuildInfo pd rootPath = dropFileName cabalPath- modPath = foldr (\a b -> a ++ "." ++ b) ""+ modPath = foldr (\a b -> a <> "." <> b) "" (map fst categories) in do window' <- liftIDE getMainWindow mbResp <- liftIO $ addModuleDialog window' modPath srcPaths (hasLibs pd) $- map exeName (executables pd) ++ map testName (testSuites pd) ++ map benchmarkName (benchmarks pd)+ map (T.pack . exeName) (executables pd)+ ++ map (T.pack . testName) (testSuites pd)+ ++ map (T.pack . benchmarkName) (benchmarks pd) case mbResp of Nothing -> return () Just addMod@(AddModule modPath srcPath libExposed exesAndTests) ->- case simpleParse modPath of- Nothing -> liftIDE $ ideMessage Normal (printf (__ "Not a valid module name : %s") modPath)+ case simpleParse $ T.unpack modPath of+ Nothing -> liftIDE $ ideMessage Normal (T.pack $ printf (__ "Not a valid module name : %s") (T.unpack modPath)) Just moduleName -> do let target = srcPath </> toFilePath moduleName ++ ".hs" liftIO $ createDirectoryIfMissing True (dropFileName target) alreadyExists <- liftIO $ doesFileExist target if alreadyExists then do- liftIDE $ ideMessage Normal (printf (__ "File already exists! Importing existing file %s.hs") (takeBaseName target))+ liftIDE $ ideMessage Normal (T.pack $ printf (__ "File already exists! Importing existing file %s.hs") (takeBaseName target)) addModuleToPackageDescr moduleName $ addModuleLocations addMod packageConfig else do template <- liftIO $ getEmptyModuleTemplate pd modPath- liftIO $ UTF8.writeFile target template+ liftIO $ T.writeFile target template addModuleToPackageDescr moduleName $ addModuleLocations addMod packageConfig liftIDE $ fileOpenThis target@@ -1139,10 +1159,10 @@ -- Yet another stupid little dialog data AddModule = AddModule {- moduleName :: String,+ moduleName :: Text, sourceRoot :: FilePath, libExposed :: Maybe Bool,- exesAndTests :: Set String}+ exesAndTests :: Set Text} addModuleLocations :: AddModule -> [ModuleLocation] addModuleLocations addMod = lib (libExposed addMod)@@ -1152,7 +1172,7 @@ lib (Just False) = [LibOtherMod] lib Nothing = [] -addModuleDialog :: Window -> String -> [String] -> Bool -> [String] -> IO (Maybe AddModule)+addModuleDialog :: Window -> Text -> [FilePath] -> Bool -> [Text] -> IO (Maybe AddModule) addModuleDialog parent modString sourceRoots hasLib exesTests = do liftIO $ debugM "leksah" "addModuleDialog" dia <- dialogNew@@ -1188,22 +1208,22 @@ ResponseOk -> return value _ -> return Nothing -moduleFields :: [FilePath] -> Bool -> [String] -> FieldDescription AddModule+moduleFields :: [FilePath] -> Bool -> [Text] -> FieldDescription AddModule moduleFields list hasLibs exesTests = VFD emptyParams $ [ mkField (paraName <<<- ParaName ((__ "New module ")) $ emptyParams) moduleName (\ a b -> b{moduleName = a})- (stringEditor (const True) True),+ (textEditor (const True) True), mkField (paraName <<<- ParaName ((__ "Root of the source path")) $ paraMultiSel <<<- ParaMultiSel False $ paraMinSize <<<- ParaMinSize (-1, 120) $ emptyParams)- (\a -> sourceRoot a)- (\ a b -> b{sourceRoot = a})- (staticListEditor list id)]+ (\a -> T.pack $ sourceRoot a)+ (\ a b -> b{sourceRoot = T.unpack a})+ (staticListEditor (map T.pack list) id)] ++ (if hasLibs then [ mkField@@ -1215,7 +1235,7 @@ else []) ++ map (\ name -> mkField- (paraName <<<- ParaName ((__ "Include in ") ++ name)+ (paraName <<<- ParaName ((__ "Include in ") <> name) $ emptyParams) (Set.member name . exesAndTests) (\ a b -> b{exesAndTests = (if a then Set.insert else Set.delete) name (exesAndTests b)})@@ -1319,7 +1339,7 @@ liftIO $ writeIORef (oldSelection mods) (oldSel{moduleS'= selMod, facetS' = selFacet}) return () -replaySelHistory :: Maybe ModuleName -> Maybe String -> IDEAction+replaySelHistory :: Maybe ModuleName -> Maybe Text -> IDEAction replaySelHistory mbModName mbFacetName = do liftIO $ debugM "leksah" "replaySelHistory" mods <- getModules Nothing
src/IDE/Pane/PackageEditor.hs view
@@ -1,6 +1,11 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable,- CPP, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.PackageEditor@@ -44,19 +49,11 @@ import Distribution.ModuleName(ModuleName) import Data.Typeable (Typeable(..)) import Graphics.UI.Editor.Composite- (versionEditor,- versionRangeEditor,- dependenciesEditor,- stringsEditor,- filesEditor,- tupel3Editor,- eitherOrEditor,- maybeEditor,- pairEditor,- ColumnDescr(..),- multisetEditor)+ (versionEditor, versionRangeEditor,+ dependenciesEditor, textsEditor, filesEditor, tupel3Editor,+ eitherOrEditor, maybeEditor, pairEditor, ColumnDescr(..),+ multisetEditor) import Distribution.Text (simpleParse, display)-import MyMissing import Graphics.UI.Editor.Parameters (paraInnerPadding, paraInnerAlignment,@@ -74,16 +71,14 @@ paraName, getParameterPrim) import Graphics.UI.Editor.Simple- (comboEntryEditor, staticListMultiEditor, intEditor, boolEditor,- fileEditor, comboSelectionEditor, multilineStringEditor,- stringEditor)+ (stringEditor, comboEntryEditor,+ staticListMultiEditor, intEditor, boolEditor, fileEditor,+ comboSelectionEditor, multilineStringEditor, textEditor) import Graphics.UI.Editor.Basics (Notifier, Editor(..), GUIEventSelector(..), GUIEvent(..)) import Distribution.Compiler (CompilerFlavor(..))-#if !MIN_VERSION_Cabal(1,11,0) import Distribution.Simple (knownExtensions)-#endif import Distribution.Simple (Extension(..), VersionRange, anyVersion) import Default (Default(..)) import IDE.Utils.GUIUtils@@ -92,6 +87,7 @@ import qualified Graphics.UI.Gtk.Gdk.Events as GTK (Event(..)) import Data.List (isPrefixOf, sort, nub)+import Data.Text (Text) import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift)@@ -100,17 +96,26 @@ (writeGenericPackageDescription) import Distribution.Version (Version(..), orLaterVersion) -import Text.Printf (printf) import Control.Applicative ((<*>), (<$>))-import qualified Data.Conduit.Util as CU (zipSinks) import IDE.Utils.Tool (ToolOutput(..)) import System.Exit (ExitCode(..)) import qualified Data.Conduit.List as CL (fold)-import qualified Data.Conduit as C (Sink)+import qualified Data.Conduit as C (Sink, ZipSink(..), getZipSink) import IDE.Utils.ExternalTool (runExternalTool') import qualified System.IO.Strict as S (readFile) import Data.Char (toLower)+import qualified Data.Text as T+ (replace, span, splitAt, isPrefixOf, length, toLower, lines,+ unlines, pack, unpack, null)+import Data.Monoid ((<>))+import qualified Data.Text.IO as T (writeFile, readFile)+import qualified Text.Printf as S (printf)+import Text.Printf (PrintfType)+import MyMissing (forceJust) +printf :: PrintfType r => Text -> r+printf = S.printf . T.unpack+ -- | Get the last item sinkLast = CL.fold (\_ a -> Just a) Nothing @@ -227,9 +232,9 @@ unknown _ = True data NewPackage = NewPackage {- newPackageName :: String,+ newPackageName :: Text, newPackageParentDir :: FilePath,- templatePackage :: String}+ templatePackage :: Text} packageFields :: FilePath -> FieldDescription NewPackage packageFields workspaceDir = VFD emptyParams [@@ -238,7 +243,7 @@ $ emptyParams) newPackageName (\ a b -> b{newPackageName = a})- (stringEditor (const True) True),+ (textEditor (const True) True), mkField (paraName <<<- ParaName ((__ "Parent directory")) $ paraMinSize <<<- ParaMinSize (-1, 120)@@ -271,8 +276,8 @@ lower <- dialogGetActionArea dia (widget,inj,ext,_) <- buildEditor (packageFields workspaceDir) (NewPackage "" workspaceDir "hello")- okButton <- dialogAddButton dia "Ok" ResponseOk- dialogAddButton dia "Cancel" ResponseCancel+ okButton <- dialogAddButton dia (__"Create Package") ResponseOk+ dialogAddButton dia (__"Cancel") ResponseCancel boxPackStart (castToBox upper) widget PackGrow 7 set okButton [widgetCanDefault := True] widgetGrabDefault okButton@@ -291,17 +296,17 @@ mbNewPackage <- liftIO $ newPackageDialog (head windows) workspaceDir case mbNewPackage of Nothing -> return ()- Just NewPackage{..} | null templatePackage -> do- let dirName = newPackageParentDir </> newPackageName+ Just NewPackage{..} | T.null templatePackage -> do+ let dirName = newPackageParentDir </> T.unpack newPackageName mbCabalFile <- liftIO $ cabalFileName dirName window <- getMainWindow case mbCabalFile of Just cfn -> do add <- liftIO $ do md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- $ (printf (__+ (T.pack $ printf (__ "There is already file %s in this directory. Would you like to add this package to the workspace?")- (takeFileName cfn) )+ (takeFileName cfn)) dialogAddButton md (__ "_Add Package") (ResponseUser 1) dialogSetDefaultResponse md (ResponseUser 1) set md [ windowWindowPosition := WinPosCenterOnParent ]@@ -316,8 +321,8 @@ then return True else liftIO $ do md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- $ (printf (__- "The path you have choosen %s is not an empty directory. Are you sure you want to make a new package here?")+ (T.pack $ printf (__+ "The path you have choosen %s is not an empty directory. Are you sure you want to make a new package here?") dirName) dialogAddButton md (__ "_Make Package Here") (ResponseUser 1) dialogSetDefaultResponse md (ResponseUser 1)@@ -329,7 +334,7 @@ modules <- liftIO $ allModules dirName let Just initialVersion = simpleParse "0.0.1" editPackage emptyPackageDescription {- package = PackageIdentifier (PackageName newPackageName)+ package = PackageIdentifier (PackageName $ T.unpack newPackageName) initialVersion , buildType = Just Simple , specVersionRaw = Right (orLaterVersion (Version [1,2] []))@@ -337,12 +342,12 @@ Dependency (PackageName "base") anyVersion , Dependency (PackageName "QuickCheck") anyVersion] , executables = [emptyExecutable {- exeName = newPackageName+ exeName = T.unpack newPackageName , modulePath = "Main.hs" , buildInfo = emptyBuildInfo { hsSourceDirs = ["src"]}}] , testSuites = [emptyTestSuite {- testName = "test-" ++ newPackageName+ testName = "test-" ++ T.unpack newPackageName , testInterface = (TestSuiteExeV10 (Version [1,0] []) "Main.hs") , testBuildInfo = emptyBuildInfo { hsSourceDirs = ["src"]@@ -352,14 +357,15 @@ return () Just NewPackage{..} -> cabalUnpack newPackageParentDir templatePackage False (Just newPackageName) log (activateAction False) +standardSetup :: Text standardSetup = "#!/usr/bin/runhaskell \n"- ++ "> module Main where\n"- ++ "> import Distribution.Simple\n"- ++ "> main :: IO ()\n"- ++ "> main = defaultMain\n\n"+ <> "> module Main where\n"+ <> "> import Distribution.Simple\n"+ <> "> main :: IO ()\n"+ <> "> main = defaultMain\n\n" data ClonePackageSourceRepo = ClonePackageSourceRepo {- packageToClone :: String,+ packageToClone :: Text, cloneParentDir :: FilePath} cloneFields :: [PackageId] -> FilePath -> FieldDescription ClonePackageSourceRepo@@ -369,7 +375,7 @@ $ emptyParams) packageToClone (\ a b -> b{packageToClone = a})- (comboEntryEditor ((sort . nub) (map (display . pkgName) packages))),+ (comboEntryEditor ((sort . nub) (map (T.pack . display . pkgName) packages))), mkField (paraName <<<- ParaName ((__ "Parent directory")) $ paraMinSize <<<- ParaMinSize (-1, 120)@@ -392,8 +398,8 @@ lower <- dialogGetActionArea dia (widget,inj,ext,_) <- buildEditor (cloneFields packages workspaceDir) (ClonePackageSourceRepo "" workspaceDir)- okButton <- dialogAddButton dia "Ok" ResponseOk- dialogAddButton dia "Cancel" ResponseCancel+ okButton <- dialogAddButton dia (__"Clone Package") ResponseOk+ dialogAddButton dia (__"Cancel") ResponseCancel boxPackStart (castToBox upper) widget PackGrow 7 set okButton [widgetCanDefault := True] widgetGrabDefault okButton@@ -414,67 +420,68 @@ Nothing -> return () Just ClonePackageSourceRepo{..} -> cabalUnpack cloneParentDir packageToClone True Nothing log activateAction -cabalUnpack :: FilePath -> String -> Bool -> Maybe String -> C.Sink ToolOutput IDEM () -> (FilePath -> IDEAction) -> IDEAction+cabalUnpack :: FilePath -> Text -> Bool -> Maybe Text -> C.Sink ToolOutput IDEM () -> (FilePath -> IDEAction) -> IDEAction cabalUnpack parentDir packageToUnpack sourceRepo mbNewName log activateAction = do- let tempDir = parentDir </> (packageToUnpack ++ ".leksah.temp")+ let tempDir = parentDir </> (T.unpack packageToUnpack ++ ".leksah.temp") liftIO $ do oldDirExists <- doesDirectoryExist tempDir when oldDirExists $ removeDirectoryRecursive tempDir createDirectory tempDir runExternalTool' (__ "Unpacking") "cabal" (["unpack"] ++ (if sourceRepo then ["--source-repository"] else [])- ++ ["--destdir=" ++ tempDir, packageToUnpack]) tempDir $ do- (mbLastOutput, _) <- CU.zipSinks sinkLast log+ ++ ["--destdir=" <> T.pack tempDir, packageToUnpack]) tempDir $ do+ mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink log case mbLastOutput of Just (ToolExit ExitSuccess) -> do contents <- liftIO $ getDirectoryContents tempDir case filter (not . isPrefixOf ".") contents of [] -> do liftIO $ removeDirectoryRecursive tempDir- lift $ ideMessage High $ "Nothing found in " ++ tempDir ++ " after doing a cabal unpack."+ lift $ ideMessage High $ "Nothing found in " <> T.pack tempDir <> " after doing a cabal unpack." [repoName] -> do- let destDir = parentDir </> (fromMaybe repoName mbNewName)+ let destDir = parentDir </> (fromMaybe repoName $ T.unpack <$> mbNewName) exists <- liftIO $ (||) <$> doesDirectoryExist destDir <*> doesFileExist destDir if exists- then lift $ ideMessage High $ destDir ++ " already exists"+ then lift $ ideMessage High $ T.pack destDir <> " already exists" else do liftIO $ renameDirectory (tempDir </> repoName) destDir mbCabalFile <- liftIO $ cabalFileName destDir window <- lift $ getMainWindow lift $ case (mbCabalFile, mbNewName) of (Just cfn, Just newName) -> do- let newCfn = takeDirectory cfn </> newName ++ ".cabal"+ let newCfn = takeDirectory cfn </> (T.unpack newName) ++ ".cabal" when (cfn /= newCfn) . liftIO $ do- s <- S.readFile cfn- writeFile newCfn $ renameCabalFile (takeBaseName cfn) newName s+ s <- T.readFile cfn+ T.writeFile newCfn $ renameCabalFile (T.pack $ takeBaseName cfn) newName s removeFile cfn activateAction newCfn (Just cfn, _) -> activateAction cfn- _ -> ideMessage High $ "Unpacked source reposity to " ++ destDir ++ " but it does not contain a .cabal file in the root directory."+ _ -> ideMessage High $ "Unpacked source reposity to " <> T.pack destDir <> " but it does not contain a .cabal file in the root directory." liftIO $ removeDirectoryRecursive tempDir _ -> do liftIO $ removeDirectoryRecursive tempDir- lift $ ideMessage High $ "More than one subdirectory found in " ++ tempDir ++ " after doing a cabal unpack."+ lift $ ideMessage High $ "More than one subdirectory found in " <> T.pack tempDir <> " after doing a cabal unpack." _ -> do liftIO $ removeDirectoryRecursive tempDir- lift $ ideMessage High $ "Failed to unpack source reposity to " ++ tempDir+ lift $ ideMessage High $ "Failed to unpack source reposity to " <> T.pack tempDir -renameCabalFile :: String -> String -> String -> String-renameCabalFile oldName newName = unlines . map renameLine . lines+renameCabalFile :: Text -> Text -> Text -> Text+renameCabalFile oldName newName = T.unlines . map renameLine . T.lines where prefixes = ["name:", "executable ", "test-suite "]- prefixesWithLength = zip prefixes $ map length prefixes- renameLine :: String -> String+ prefixesWithLength :: [(Text, Int)]+ prefixesWithLength = zip prefixes $ map T.length prefixes+ renameLine :: Text -> Text renameLine line =- case catMaybes $ map (rename (line, map toLower line)) prefixesWithLength of+ case catMaybes $ map (rename (line, T.toLower line)) prefixesWithLength of l:_ -> l [] -> line- rename :: (String, String) -> (String, Int) -> Maybe String- rename (line, lcLine) (lcPrefix, pLen) | lcPrefix `isPrefixOf` lcLine =- let (prefix, rest) = splitAt pLen line- (spaces, value) = span (==' ') rest in- Just $ prefix ++ spaces ++ replace oldName newName value+ rename :: (Text, Text) -> (Text, Int) -> Maybe Text+ rename (line, lcLine) (lcPrefix, pLen) | lcPrefix `T.isPrefixOf` lcLine =+ let (prefix, rest) = T.splitAt pLen line+ (spaces, value) = T.span (==' ') rest in+ Just $ prefix <> spaces <> T.replace oldName newName value rename _ _ = Nothing -- ---------------------------------------------------------------------@@ -504,14 +511,14 @@ benchmarks' mbLib' buildInfos) = let exes = map (\ (Executable' s fb bii) -> if bii + 1 > length buildInfos- then Executable s fb (buildInfos !! (length buildInfos - 1))- else Executable s fb (buildInfos !! bii)) exes'+ then Executable (T.unpack s) fb (buildInfos !! (length buildInfos - 1))+ else Executable (T.unpack s) fb (buildInfos !! bii)) exes' tests = map (\ (Test' s fb bii) -> if bii + 1 > length buildInfos- then TestSuite s fb (buildInfos !! (length buildInfos - 1)) False- else TestSuite s fb (buildInfos !! bii) False) tests'+ then TestSuite (T.unpack s) fb (buildInfos !! (length buildInfos - 1)) False+ else TestSuite (T.unpack s) fb (buildInfos !! bii) False) tests' bms = map (\ (Benchmark' s fb bii) -> if bii + 1 > length buildInfos- then Benchmark s fb (buildInfos !! (length buildInfos - 1)) False- else Benchmark s fb (buildInfos !! bii) False) benchmarks'+ then Benchmark (T.unpack s) fb (buildInfos !! (length buildInfos - 1)) False+ else Benchmark (T.unpack s) fb (buildInfos !! bii) False) benchmarks' mbLib = case mbLib' of Nothing -> Nothing Just (Library' mn b bii) -> if bii + 1 > length buildInfos@@ -526,11 +533,11 @@ toEditor :: PackageDescription -> PackageDescriptionEd toEditor pd =- let (exes,exeBis) = unzip $ map (\((Executable s fb bi), i) -> ((Executable' s fb i), bi))+ let (exes,exeBis) = unzip $ map (\((Executable s fb bi), i) -> ((Executable' (T.pack s) fb i), bi)) (zip (executables pd) [0..])- (tests,testBis) = unzip $ map (\((TestSuite s fb bi _), i) -> ((Test' s fb i), bi))+ (tests,testBis) = unzip $ map (\((TestSuite s fb bi _), i) -> ((Test' (T.pack s) fb i), bi)) (zip (testSuites pd) [length exeBis..])- (bms,benchmarkBis) = unzip $ map (\((Benchmark s fb bi _), i) -> ((Benchmark' s fb i), bi))+ (bms,benchmarkBis) = unzip $ map (\((Benchmark s fb bi _), i) -> ((Benchmark' (T.pack s) fb i), bi)) (zip (benchmarks pd) [length testBis..]) bis = exeBis ++ testBis ++ benchmarkBis (mbLib,bis2) = case library pd of@@ -639,7 +646,7 @@ closeB <- buttonNewFromStock "gtk-close" addB <- buttonNewFromStock (__ "Add Build Info") removeB <- buttonNewFromStock (__ "Remove Build Info")- label <- labelNew Nothing+ label <- labelNew (Nothing :: Maybe Text) boxPackStart bb addB PackNatural 0 boxPackStart bb removeB PackNatural 0 boxPackEnd bb closeB PackNatural 0@@ -720,14 +727,14 @@ let hasChanged = case mbP of Nothing -> False Just p -> p /= origPackageD- when (isJust mbP) $ labelSetMarkup label ""+ when (isJust mbP) $ labelSetMarkup label ("" :: Text) when (isJust mbP) $ comparePDE (fromJust mbP) packageD markLabel nb (getTopWidget packagePane) hasChanged widgetSetSensitive save hasChanged return (e{gtkReturn=False})) registerEvent notifier ValidationError (\e -> do labelSetMarkup label $ "<span foreground=\"red\" size=\"x-large\">The following fields have invalid values: "- ++ eventText e ++ "</span>"+ <> eventText e <> "</span>" return e) return (Just packagePane,[]) @@ -739,7 +746,7 @@ -> FilePath -> [ModuleName] -> Int- -> [(String, FieldDescription PackageDescriptionEd)]+ -> [(Text, FieldDescription PackageDescriptionEd)] -> FieldDescription PackageDescriptionEd packageDD packages fp modules numBuildInfos extras = NFD ([ ((__ "Package"), VFD emptyParams [@@ -761,8 +768,8 @@ $ paraShadow <<<- ParaShadow ShadowOut $ paraMinSize <<<- ParaMinSize (-1,210) $ emptyParams)- (description . pd)- (\ a b -> b{pd = (pd b){description = if null a then " " else a}})+ (T.pack . description . pd)+ (\ a b -> b{pd = (pd b){description = T.unpack $ if T.null a then " " else a}}) multilineStringEditor , mkField (paraName <<<- ParaName (__ "Homepage") $ emptyParams)@@ -914,8 +921,8 @@ (customFieldsPD . pd) (\ a b -> b{pd = (pd b){customFieldsPD = a}}) (multisetEditor- (ColumnDescr True [((__ "Name"),\(n,_) -> [cellText := n])- ,((__ "Value"),\(_,v) -> [cellText := v])])+ (ColumnDescr True [((__ "Name"),\(n,_) -> [cellText := T.pack n])+ ,((__ "Value"),\(_,v) -> [cellText := T.pack v])]) ((pairEditor (stringxEditor (const True),emptyParams) (stringEditor (const True) True,emptyParams)),emptyParams)@@ -975,9 +982,9 @@ else bi) (zip bis [0..length bis - 1]) -buildInfoD :: Maybe FilePath -> [ModuleName] -> Int -> [(String,FieldDescription PackageDescriptionEd)]+buildInfoD :: Maybe FilePath -> [ModuleName] -> Int -> [(Text,FieldDescription PackageDescriptionEd)] buildInfoD fp modules i = [- ((printf (__ "%s Build Info") (show (i + 1))), VFD emptyParams [+ ((T.pack $ printf (__ "%s Build Info") (show (i + 1))), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "Component is buildable here") $ emptyParams) (buildable . (\a -> a !! i) . bis)@@ -1004,13 +1011,13 @@ $ paraMinSize <<<- ParaMinSize (-1,300) $ paraPack <<<- ParaPack PackGrow $ emptyParams)- (map display. otherModules . (\a -> a !! i) . bis)+ (map (T.pack . display) . otherModules . (\a -> a !! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi ->- bi{otherModules = (map (\i -> forceJust (simpleParse i)+ bi{otherModules = (map (\i -> forceJust (simpleParse $ T.unpack i) " PackageEditor >> buildInfoD: no parse for moduile name" ) a)})}) (modulesEditor modules) ]),- ((printf (__ "%s Compiler ") (show (i + 1))), VFD emptyParams [+ ((T.pack $ printf (__ "%s Compiler ") (show (i + 1))), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "Options for haskell compilers") $ paraDirection <<<- ParaDirection Vertical@@ -1019,8 +1026,8 @@ (options . (\a -> a !! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{options = a})}) (multisetEditor- (ColumnDescr True [( (__ "Compiler Flavor"),\(cv,_) -> [cellText := show cv])- ,( (__ "Options"),\(_,op) -> [cellText := concatMap (\s -> ' ' : s) op])])+ (ColumnDescr True [( (__ "Compiler Flavor"),\(cv,_) -> [cellText := T.pack $ show cv])+ ,( (__ "Options"),\(_,op) -> [cellText := T.pack $ concatMap (\s -> ' ' : s) op])]) ((pairEditor (compilerFlavorEditor,emptyParams) (optsEditor,emptyParams)),@@ -1041,7 +1048,7 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{ghcSharedOptions = a})}) optsEditor ]),- ((printf (__ "%s Extensions ") (show (i + 1))), VFD emptyParams [+ ((T.pack $ printf (__ "%s Extensions ") (show (i + 1))), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "Extensions") $ paraSynopsis <<<- ParaSynopsis@@ -1053,7 +1060,7 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{oldExtensions = a})}) extensionsEditor ]),- ((printf (__ "%s Build Tools ") (show (i + 1))), VFD emptyParams [+ ((T.pack $ printf (__ "%s Build Tools ") (show (i + 1))), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "Tools needed for a build") $ paraDirection <<<- ParaDirection Vertical@@ -1063,7 +1070,7 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{buildTools = a})}) (dependenciesEditor []) ]),- ( (printf (__ "%s Pkg Config ") (show (i + 1))), VFD emptyParams [+ ((T.pack $ printf (__ "%s Pkg Config ") (show (i + 1))), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "A list of pkg-config packages, needed to build this package") $ paraDirection <<<- ParaDirection Vertical@@ -1073,7 +1080,7 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{pkgconfigDepends = a})}) (dependenciesEditor []) ]),- ( (printf (__ "%s Opts C -1-") (show (i + 1))), VFD emptyParams [+ ((T.pack $ printf (__ "%s Opts C -1-") (show (i + 1))), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "Options for C compiler") $ paraDirection <<<- ParaDirection Vertical@@ -1091,9 +1098,9 @@ , mkField (paraName <<<- ParaName (__ "A list of header files to use when compiling") $ paraDirection <<<- ParaDirection Vertical $ emptyParams)- (includes . (\a -> a !! i) . bis)- (\ a b -> b{bis = update (bis b) i (\bi -> bi{includes = a})})- (stringsEditor (const True) True)+ (map T.pack . includes . (\a -> a !! i) . bis)+ (\ a b -> b{bis = update (bis b) i (\bi -> bi{includes = map T.unpack a})})+ (textsEditor (const True) True) , mkField (paraName <<<- ParaName (__ "A list of header files to install") $ paraMinSize <<<- ParaMinSize (-1,150)@@ -1102,7 +1109,7 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{installIncludes = a})}) (filesEditor fp FileChooserActionOpen (__ "Select File")) ]),- ((printf (__ "%s Opts C -2-") (show (i + 1))), VFD emptyParams [+ ((T.pack $ printf (__ "%s Opts C -2-") (show (i + 1))), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "A list of directories to search for header files") $ paraMinSize <<<- ParaMinSize (-1,150)@@ -1119,14 +1126,14 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{cSources = a})}) (filesEditor fp FileChooserActionOpen (__ "Select file")) ]),- ((printf (__ "%s Opts Libs ") (show (i + 1))), VFD emptyParams [+ ((T.pack $ printf (__ "%s Opts Libs ") (show (i + 1))), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "A list of extra libraries to link with") $ paraMinSize <<<- ParaMinSize (-1,150) $ paraDirection <<<- ParaDirection Vertical $ emptyParams)- (extraLibs . (\a -> a !! i) . bis)- (\ a b -> b{bis = update (bis b) i (\bi -> bi{extraLibs = a})})- (stringsEditor (const True) True)+ (map T.pack . extraLibs . (\a -> a !! i) . bis)+ (\ a b -> b{bis = update (bis b) i (\bi -> bi{extraLibs = map T.unpack a})})+ (textsEditor (const True) True) , mkField (paraName <<<- ParaName (__ "A list of directories to search for libraries.") $ paraMinSize <<<- ParaMinSize (-1,150)@@ -1135,7 +1142,7 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{extraLibDirs = a})}) (filesEditor fp FileChooserActionSelectFolder (__ "Select Folder")) ]),- ( (printf (__ "%s Other") (show (i + 1))), VFD emptyParams [+ ((T.pack $ printf (__ "%s Other") (show (i + 1))), VFD emptyParams [ mkField (paraName <<<- ParaName (__ "Options for C preprocessor") $ paraDirection <<<- ParaDirection Vertical@@ -1147,9 +1154,9 @@ (paraName <<<- ParaName (__ "Support frameworks for Mac OS X") $ paraMinSize <<<- ParaMinSize (-1,150) $ paraDirection <<<- ParaDirection Vertical $ emptyParams)- (frameworks . (\a -> a !! i) . bis)- (\ a b -> b{bis = update (bis b) i (\bi -> bi{frameworks = a})})- (stringsEditor (const True) True)+ (map T.pack . frameworks . (\a -> a !! i) . bis)+ (\ a b -> b{bis = update (bis b) i (\bi -> bi{frameworks = map T.unpack a})})+ (textsEditor (const True) True) , mkField (paraName <<<- ParaName (__ "Custom fields build info") $ paraShadow <<<- ParaShadow ShadowIn@@ -1158,8 +1165,8 @@ (customFieldsBI . (\a -> a !! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{customFieldsBI = a})}) (multisetEditor- (ColumnDescr True [((__ "Name"),\(n,_) -> [cellText := n])- ,((__ "Value"),\(_,v) -> [cellText := v])])+ (ColumnDescr True [((__ "Name"),\(n,_) -> [cellText := T.pack n])+ ,((__ "Value"),\(_,v) -> [cellText := T.pack v])]) ((pairEditor (stringxEditor (const True),emptyParams) (stringEditor (const True) True,emptyParams)),emptyParams)@@ -1215,8 +1222,8 @@ testedWithEditor :: Editor [(CompilerFlavor, VersionRange)] testedWithEditor para = do multisetEditor- (ColumnDescr True [((__ "Compiler Flavor"),\(cv,_) -> [cellText := show cv])- ,((__ "Version Range"),\(_,vr) -> [cellText := display vr])])+ (ColumnDescr True [((__ "Compiler Flavor"),\(cv,_) -> [cellText := T.pack $ show cv])+ ,((__ "Version Range"),\(_,vr) -> [cellText := T.pack $ display vr])]) (pairEditor (compilerFlavorEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams) (versionRangeEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams),@@ -1228,19 +1235,19 @@ compilerFlavorEditor :: Editor CompilerFlavor compilerFlavorEditor para noti = do (wid,inj,ext) <- eitherOrEditor- (comboSelectionEditor flavors show, paraName <<<- (ParaName (__ "Select compiler")) $ emptyParams)- (stringEditor (\s -> not (null s)) True, paraName <<<- (ParaName (__ "Specify compiler")) $ emptyParams)+ (comboSelectionEditor flavors (T.pack . show), paraName <<<- (ParaName (__ "Select compiler")) $ emptyParams)+ (textEditor (\s -> not (T.null s)) True, paraName <<<- (ParaName (__ "Specify compiler")) $ emptyParams) (__ "Other") (paraName <<<- ParaName (__ "Select") $ para) noti let cfinj comp = case comp of- (OtherCompiler str) -> inj (Right str)+ (OtherCompiler str) -> inj (Right $ T.pack str) other -> inj (Left other) let cfext = do mbp <- ext case mbp of Nothing -> return Nothing- Just (Right s) -> return (Just $OtherCompiler s)+ Just (Right s) -> return (Just . OtherCompiler $ T.unpack s) Just (Left other) -> return (Just other) return (wid,cfinj,cfext) where@@ -1249,34 +1256,30 @@ buildTypeEditor :: Editor BuildType buildTypeEditor para noti = do (wid,inj,ext) <- eitherOrEditor- (comboSelectionEditor flavors show, paraName <<<- (ParaName (__ "Select")) $ emptyParams)- (stringEditor (const True) True, paraName <<<- (ParaName (__ "Unknown")) $ emptyParams)+ (comboSelectionEditor flavors (T.pack . show), paraName <<<- (ParaName (__ "Select")) $ emptyParams)+ (textEditor (const True) True, paraName <<<- (ParaName (__ "Unknown")) $ emptyParams) (__ "Unknown") (paraName <<<- ParaName (__ "Select") $ para) noti let cfinj comp = case comp of- (UnknownBuildType str) -> inj (Right str)+ (UnknownBuildType str) -> inj (Right $ T.pack str) other -> inj (Left other) let cfext = do mbp <- ext case mbp of Nothing -> return Nothing- Just (Right s) -> return (Just $ UnknownBuildType s)+ Just (Right s) -> return (Just . UnknownBuildType $ T.unpack s) Just (Left other) -> return (Just other) return (wid,cfinj,cfext) where flavors = [Simple, Configure, Make, Custom] extensionsEditor :: Editor [Extension]-extensionsEditor = staticListMultiEditor extensionsL show+extensionsEditor = staticListMultiEditor extensionsL (T.pack . show) extensionsL :: [Extension]-#if MIN_VERSION_Cabal(1,11,0) extensionsL = map EnableExtension [minBound..maxBound]-#else-extensionsL = knownExtensions-#endif {-- reposEditor :: Editor [SourceRepo]@@ -1312,11 +1315,11 @@ (widg,inj,ext) <- tupel7Editor (repoKindEditor,noBorder) (maybeEditor (repoTypeEditor,noBorder) True "Specify a type", emptyParams)- (maybeEditor (stringEditor (const True) True,noBorder) True "Specify a location", emptyParams)- (maybeEditor (stringEditor (const True) True,noBorder) True "Specify a module", emptyParams)- (maybeEditor (stringEditor (const True) True,noBorder) True "Specify a branch", emptyParams)- (maybeEditor (stringEditor (const True) True,noBorder) True "Specify a tag", emptyParams)- (maybeEditor (stringEditor (const True) True,noBorder) True "Specify a subdir", emptyParams)+ (maybeEditor (textEditor (const True) True,noBorder) True "Specify a location", emptyParams)+ (maybeEditor (textEditor (const True) True,noBorder) True "Specify a module", emptyParams)+ (maybeEditor (textEditor (const True) True,noBorder) True "Specify a branch", emptyParams)+ (maybeEditor (textEditor (const True) True,noBorder) True "Specify a tag", emptyParams)+ (maybeEditor (textEditor (const True) True,noBorder) True "Specify a subdir", emptyParams) (paraDirection <<<- ParaDirection Vertical $ noBorder) noti return (widg,@@ -1336,7 +1339,7 @@ repoKindEditor paras noti = do (widg,inj,ext) <- pairEditor (comboSelectionEditor selectionList show, emptyParams)- (stringEditor (const True) True,emptyParams)+ (textEditor (const True) True,emptyParams) paras noti return (widg,@@ -1355,7 +1358,7 @@ repoTypeEditor paras noti = do (widg,inj,ext) <- pairEditor (comboSelectionEditor selectionList show, emptyParams)- (stringEditor (const True) True,emptyParams)+ (textEditor (const True) True,emptyParams) paras noti return (widg,@@ -1382,19 +1385,19 @@ deriving (Show, Eq) data Executable' = Executable'{- exeName' :: String+ exeName' :: Text , modulePath' :: FilePath , buildInfoIdx :: Int} deriving (Show, Eq) data Test' = Test'{- testName' :: String+ testName' :: Text , testInterface' :: TestSuiteInterface , testBuildInfoIdx :: Int} deriving (Show, Eq) data Benchmark' = Benchmark'{- benchmarkName' :: String+ benchmarkName' :: Text , benchmarkInterface' :: BenchmarkInterface , benchmarkBuildInfoIdx :: Int} deriving (Show, Eq)@@ -1429,28 +1432,25 @@ (paraDirection <<<- ParaDirection Vertical $ emptyParams) noti- let pinj (Library' em exp bi) = inj (exp, map display em,bi)+ let pinj (Library' em exp bi) = inj (exp, map (T.pack . display) em,bi) let pext = do mbp <- ext case mbp of Nothing -> return Nothing- Just (exp,em,bi) -> return (Just $ Library' (map (\s -> forceJust (simpleParse s)+ Just (exp,em,bi) -> return (Just $ Library' (map (\s -> forceJust (simpleParse $ T.unpack s) "SpecialEditor >> libraryEditor: no parse for moduile name") em) exp bi) return (wid,pinj,pext) ---moduleEditor :: [ModuleName] -> Editor String---moduleEditor modules = comboSelectionEditor (map display modules)--modulesEditor :: [ModuleName] -> Editor [String]-modulesEditor modules = staticListMultiEditor (map display modules) id+modulesEditor :: [ModuleName] -> Editor [Text]+modulesEditor modules = staticListMultiEditor (map (T.pack . display) modules) id executablesEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Executable'] executablesEditor fp modules countBuildInfo p = multisetEditor (ColumnDescr True [( (__ "Executable Name"),\(Executable' exeName _ _) -> [cellText := exeName])- ,( (__ "Module Path"),\(Executable' _ mp _) -> [cellText := mp])+ ,( (__ "Module Path"),\(Executable' _ mp _) -> [cellText := T.pack mp]) - ,( (__ "Build info index"),\(Executable' _ _ bii) -> [cellText := show (bii + 1)])])+ ,( (__ "Build info index"),\(Executable' _ _ bii) -> [cellText := T.pack $ show (bii + 1)])]) (executableEditor fp modules countBuildInfo,emptyParams) Nothing Nothing@@ -1460,7 +1460,7 @@ executableEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Executable' executableEditor fp modules countBuildInfo para noti = do (wid,inj,ext) <- tupel3Editor- (stringEditor (\s -> not (null s)) True,+ (textEditor (\s -> not (T.null s)) True, paraName <<<- ParaName (__ "Executable Name") $ emptyParams) (stringEditor (\s -> not (null s)) True,@@ -1487,8 +1487,8 @@ testsEditor fp modules countBuildInfo p = multisetEditor (ColumnDescr True [( (__ "Test Name"),\(Test' testName _ _) -> [cellText := testName])- ,( (__ "Interface"),\(Test' _ i _) -> [cellText := interfaceName i])- ,( (__ "Build info index"),\(Test' _ _ bii) -> [cellText := show (bii + 1)])])+ ,( (__ "Interface"),\(Test' _ i _) -> [cellText := T.pack $ interfaceName i])+ ,( (__ "Build info index"),\(Test' _ _ bii) -> [cellText := T.pack $ show (bii + 1)])]) (testEditor fp modules countBuildInfo,emptyParams) Nothing Nothing@@ -1501,7 +1501,7 @@ testEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Test' testEditor fp modules countBuildInfo para noti = do (wid,inj,ext) <- tupel3Editor- (stringEditor (\s -> not (null s)) True,+ (textEditor (\s -> not (T.null s)) True, paraName <<<- ParaName (__ "Test Name") $ emptyParams) (stringEditor (\s -> not (null s)) True,@@ -1529,8 +1529,8 @@ benchmarksEditor fp modules countBuildInfo p = multisetEditor (ColumnDescr True [( (__ "Benchmark Name"),\(Benchmark' benchmarkName _ _) -> [cellText := benchmarkName])- ,( (__ "Interface"),\(Benchmark' _ i _) -> [cellText := interfaceName i])- ,( (__ "Build info index"),\(Benchmark' _ _ bii) -> [cellText := show (bii + 1)])])+ ,( (__ "Interface"),\(Benchmark' _ i _) -> [cellText := T.pack $ interfaceName i])+ ,( (__ "Build info index"),\(Benchmark' _ _ bii) -> [cellText := T.pack $ show (bii + 1)])]) (benchmarkEditor fp modules countBuildInfo,emptyParams) Nothing Nothing@@ -1543,7 +1543,7 @@ benchmarkEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Benchmark' benchmarkEditor fp modules countBuildInfo para noti = do (wid,inj,ext) <- tupel3Editor- (stringEditor (\s -> not (null s)) True,+ (textEditor (\s -> not (T.null s)) True, paraName <<<- ParaName (__ "Benchmark Name") $ emptyParams) (stringEditor (\s -> not (null s)) True,
src/IDE/Pane/PackageFlags.hs view
@@ -1,5 +1,9 @@-{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable,- MultiParamTypeClasses, TypeSynonymInstances, Rank2Types #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.PackageFlags@@ -44,6 +48,10 @@ import Debug.Trace (trace) import IDE.Utils.GUIUtils (__) import Control.Monad (void)+import Data.Text (Text)+import Data.Monoid ((<>))+import qualified Data.Text as T (unwords, unpack, pack)+import Control.Applicative ((<$>)) data IDEFlags = IDEFlags { flagsBox :: VBox@@ -134,7 +142,7 @@ getFlags (Just pp) = forceGetPane (Left pp) quoteArg :: String -> String-quoteArg s | ' ' `elem` s = "\"" ++ escapeQuotes s ++ "\""+quoteArg s | ' ' `elem` s = "\"" <> escapeQuotes s <> "\"" quoteArg s = s escapeQuotes = foldr (\c s -> if c == '"' then '\\':c:s else c:s) ""@@ -147,28 +155,28 @@ noneOf "\"") <?> "argsParser" -argParser :: CharParser () String+argParser :: CharParser () Text argParser = try (do char '"' s <- many quotedArgCharParser char '"'- return s)+ return $ T.pack s) <|> try (- many1 (noneOf " "))+ T.pack <$> many1 (noneOf " ")) <?> "argParser" -argsParser :: CharParser () [String]+argsParser :: CharParser () [Text] argsParser = try ( many (do many (char ' ') argParser)) <?> "argsParser" -unargs :: [String] -> String-unargs = unwords . map quoteArg+unargs :: [Text] -> Text+unargs = T.unwords . map (T.pack . quoteArg . T.unpack) -args :: String -> [String]-args s = case parse argsParser "" s of+args :: Text -> [Text]+args s = case parse argsParser "" $ T.unpack s of Right result -> result _ -> [s] @@ -183,7 +191,7 @@ readParser (unargs . ipdConfigFlags) (\ b a -> a{ipdConfigFlags = args b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\ _ -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Build flags") $ emptyParams)@@ -191,7 +199,7 @@ readParser (unargs . ipdBuildFlags) (\ b a -> a{ipdBuildFlags = args b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\ _ -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Test flags") $ emptyParams)@@ -199,7 +207,7 @@ readParser (unargs . ipdTestFlags) (\ b a -> a{ipdTestFlags = args b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\ _ -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Haddock flags") $ emptyParams)@@ -207,7 +215,7 @@ readParser (unargs . ipdHaddockFlags) (\ b a -> a{ipdHaddockFlags = args b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\ _ -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Executable flags") $ emptyParams)@@ -215,7 +223,7 @@ readParser (unargs . ipdExeFlags) (\ b a -> a{ipdExeFlags = args b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\ _ -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Install flags") $ emptyParams)@@ -223,7 +231,7 @@ readParser (unargs . ipdInstallFlags) (\ b a -> a{ipdInstallFlags = args b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\ _ -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Register flags") $ emptyParams)@@ -231,7 +239,7 @@ readParser (unargs . ipdRegisterFlags) (\ b a -> a{ipdRegisterFlags = args b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\ _ -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Unregister flags") $ emptyParams)@@ -239,7 +247,7 @@ readParser (unargs . ipdUnregisterFlags) (\ b a -> a{ipdUnregisterFlags = args b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\ _ -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Source Distribution flags") $ emptyParams)@@ -247,7 +255,7 @@ readParser (unargs . ipdSdistFlags) (\ b a -> a{ipdSdistFlags = args b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\ _ -> return ())] -- ------------------------------------------------------------
src/IDE/Pane/Preferences.hs view
@@ -1,5 +1,9 @@-{-# LANGUAGE CPP, FlexibleInstances, ScopedTypeVariables, DeriveDataTypeable,- MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Preferences@@ -76,6 +80,10 @@ import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad (void, forM_, when) import System.FilePath ((</>))+import Data.Text (Text)+import qualified Data.Text as T (isSuffixOf, unpack, pack, null)+import Data.Monoid ((<>))+import Control.Applicative ((<$>)) -- --------------------------------------------------------------------- -- This needs to be incremented, when the preferences format changes@@ -127,7 +135,7 @@ (widget,injb,ext,notifier) <- buildEditor (extractFieldDescription $ prefsDescription configDir packageInfos) prefs boxPackStart vb widget PackGrow 0- label <- labelNew Nothing+ label <- labelNew (Nothing :: Maybe Text) boxPackStart vb label PackNatural 0 boxPackEnd vb bb PackNatural 5 let prefsPane = IDEPrefs vb@@ -194,13 +202,13 @@ Nothing -> False Just p -> p{prefsFormat = 0, prefsSaveTime = ""} /= prefs{prefsFormat = 0, prefsSaveTime = ""}- when (isJust mbP) $ labelSetMarkup label ""+ when (isJust mbP) $ labelSetMarkup label ("" :: Text) markLabel nb (getTopWidget prefsPane) hasChanged widgetSetSensitive save hasChanged return (e{gtkReturn=False})) registerEvent notifier ValidationError (\e -> do labelSetMarkup label $ "<span foreground=\"red\" size=\"x-large\">The following fields have invalid values: "- ++ eventText e ++ "</span>"+ <> eventText e <> "</span>" return e) return (Just prefsPane,[]) @@ -250,7 +258,7 @@ (paraName <<<- ParaName (__ "TextView Font") $ emptyParams) (\a -> PP.text (case a of Nothing -> show ""; Just s -> show s)) (do str <- stringParser- return (if null str then Nothing else Just str))+ return (if T.null str then Nothing else Just str)) textviewFont (\ b a -> a{textviewFont = b}) fontEditor@@ -318,7 +326,7 @@ (PP.text . show) readParser sourceCandy (\b a -> a{sourceCandy = b})- (disableEditor (stringEditor (not . null) True,+ (disableEditor (textEditor (not . T.null) True, paraName <<<- ParaName (__ "Candy specification") $ emptyParams) True (__ "Use it ?"))@@ -333,7 +341,7 @@ (paraName <<<- ParaName (__ "Editor Style") $ emptyParams) (\a -> PP.text (case a of (False,_) -> show ""; (True, s) -> show s)) (do str <- stringParser- return (if null str then (False, __ "classic") else (True,str)))+ return (if T.null str then (False, __ "classic") else (True,str))) sourceStyle (\b a -> a{sourceStyle = b}) styleEditor@@ -418,8 +426,8 @@ (paraName <<<- ParaName (__ "Text Editor") $ emptyParams) (PP.text . show) stringParser- textEditor- (\b a -> a{textEditor = b})+ textEditorType+ (\b a -> a{textEditorType = b}) (comboSelectionEditor ["GtkSourceView", "Yi", "CodeMirror"] id) (\i -> return ()) ]),@@ -428,7 +436,7 @@ (paraName <<<- ParaName (__ "LogView Font") $ emptyParams) (\a -> PP.text (case a of Nothing -> show ""; Just s -> show s)) (do str <- stringParser- return (if null str then Nothing else Just str))+ return (if T.null str then Nothing else Just str)) logviewFont (\ b a -> a{logviewFont = b}) fontEditor@@ -470,11 +478,11 @@ $ paraSynopsis <<<- ParaSynopsis (__ "The name of a keymap file in a config dir") $ paraDirection <<<- ParaDirection Horizontal $ emptyParams)- PP.text+ (PP.text . T.unpack) identifier keymapName (\b a -> a{keymapName = b})- (stringEditor (not . null) True)+ (textEditor (not . T.null) True) (\ a -> return ()) ]), (__ "Initial Pane positions", VFDPP emptyParams [@@ -493,8 +501,8 @@ (ColumnDescr True [(__ "Pane Id", \ (n, _) -> [cellText := n]) ,(__ "Pane Category", \ (_, v) -> [cellText := v])]) (pairEditor- (stringEditor (not . null) True, emptyParams)- (stringEditor (not . null) True, emptyParams), emptyParams)+ (textEditor (not . T.null) True, emptyParams)+ (textEditor (not . T.null) True, emptyParams), emptyParams) (Just (sortBy (\(a,_) (a2,_) -> compare a a2))) (Just (\(a,_) (a2,_) -> a == a2))) (\i -> return ())@@ -511,8 +519,8 @@ (\b a -> a{pathForCategory = b}) (multisetEditor (ColumnDescr True [(__ "Pane category", \ (n, _) -> [cellText := n])- ,(__ "Pane path", \ (_, v) -> [cellText := show v])])- (pairEditor (stringEditor (not . null) True, emptyParams)+ ,(__ "Pane path", \ (_, v) -> [cellText := T.pack $ show v])])+ (pairEditor (textEditor (not . T.null) True, emptyParams) (genericEditor, emptyParams), emptyParams) (Just (sortBy (\(a,_) (a2,_) -> compare a a2)))@@ -553,7 +561,7 @@ stringParser retrieveURL (\b a -> a{retrieveURL = b})- (stringEditor (const True) True)+ (textEditor (const True) True) (\i -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Strategy for downloading prebuilt metadata") $ emptyParams)@@ -587,7 +595,7 @@ stringParser serverIP (\b a -> a{serverIP = b})- (stringEditor (not . null) True)+ (textEditor (not . T.null) True) (\i -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "Stop the leksah-server process when leksah disconnects") $ emptyParams)@@ -729,30 +737,30 @@ stringParser browser (\b a -> a{browser = b})- (stringEditor (not . null) True)+ (textEditor (not . T.null) True) (\i -> return ()) , mkFieldPP (paraName <<<- ParaName (__ "URL for searching documentation") $ paraSynopsis <<<- ParaSynopsis- ("e.g Hoogle: http://www.haskell.org/hoogle/?q= or " +++ ("e.g Hoogle: http://www.haskell.org/hoogle/?q= or " <> "Hayoo: http://holumbus.fh-wedel.de/hayoo/hayoo.html?query=") $ emptyParams) (PP.text . show) stringParser docuSearchURL (\b a -> a{docuSearchURL = b})- (stringEditor (not . null) True)+ (textEditor (not . T.null) True) (\i -> return ()) ])] -styleEditor :: Editor (Bool, String)+styleEditor :: Editor (Bool, Text) styleEditor p n = do styleManager <- sourceStyleSchemeManagerNew dataDir <- getDataDir sourceStyleSchemeManagerAppendSearchPath styleManager $ dataDir </> "data/styles" ids <- sourceStyleSchemeManagerGetSchemeIds styleManager- let notDarkIds = filter (not . isSuffixOf "-dark") ids+ let notDarkIds = filter (not . T.isSuffixOf "-dark") ids disableEditor (comboSelectionEditor notDarkIds id, p) True (__ "Select a special style?") p n @@ -773,7 +781,7 @@ , matchBackground = Color 32768 32768 32768 , contextBackground = Color 65535 49152 49152 , breakpointBackground = Color 65535 49152 32768- , textEditor = "GtkSourceView"+ , textEditorType = "GtkSourceView" , autoLoad = False , logviewFont = Nothing , defaultSize = (1024,800)@@ -838,9 +846,9 @@ readPrefs fn = catch (do configDir <- getConfigDir readFields fn (flattenFieldDescriptionPPToS (prefsDescription configDir [])) defaultPrefs)- (\ (e :: SomeException) -> do- sysMessage Normal (show e)- return defaultPrefs)+ (\ (e :: SomeException) -> do+ sysMessage Normal (T.pack $ show e)+ return defaultPrefs) -- ------------------------------------------------------------ -- * Printing -- ------------------------------------------------------------@@ -849,7 +857,7 @@ writePrefs fpath prefs = do timeNow <- liftIO getClockTime configDir <- getConfigDir- let newPrefs = prefs {prefsSaveTime = show timeNow, prefsFormat = prefsVersion}+ let newPrefs = prefs {prefsSaveTime = T.pack $ show timeNow, prefsFormat = prefsVersion} writeFields fpath newPrefs (flattenFieldDescriptionPPToS (prefsDescription configDir []))
src/IDE/Pane/Search.hs view
@@ -1,5 +1,8 @@-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses,- TypeSynonymInstances, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Search@@ -63,6 +66,8 @@ import System.Glib.Properties (newAttrFromMaybeStringProperty) import Control.Monad (void) import Graphics.UI.Gtk.General.Enums (ShadowType(..))+import Data.Text (Text)+import qualified Data.Text as T (pack, null) -- | A search pane description --@@ -77,12 +82,12 @@ , entry :: Entry , scopeSelection :: Scope -> IDEAction , modeSelection :: SearchMode -> IDEAction-, searchMetaGUI :: String -> IDEAction+, searchMetaGUI :: Text -> IDEAction , setChoices :: [Descr] -> IDEAction } deriving Typeable data SearchState = SearchState {- searchString :: String+ searchString :: Text , searchScope :: Scope , searchMode :: SearchMode } deriving(Eq,Ord,Read,Show,Typeable)@@ -178,11 +183,11 @@ cellLayoutSetAttributes col1 renderer1 listStore $ \row -> [ cellText := case dsMbModu row of Nothing -> ""- Just pm -> display $ modu pm]+ Just pm -> T.pack . display $ modu pm] cellLayoutSetAttributes col1 renderer10 listStore $ \row -> [newAttrFromMaybeStringProperty "stock-id" := if isReexported row- then Just "ide_reexported"+ then Just ("ide_reexported" :: Text) else if isJust (dscMbLocation row) then Just "ide_source" else Nothing]@@ -198,7 +203,7 @@ cellLayoutSetAttributes col2 renderer2 listStore $ \row -> [ cellText := case dsMbModu row of Nothing -> ""- Just pm -> display $ pack pm]+ Just pm -> T.pack . display $ pack pm] renderer3 <- cellRendererTextNew col3 <- treeViewColumnNew@@ -209,7 +214,7 @@ treeViewAppendColumn treeView col3 cellLayoutPackStart col3 renderer3 True cellLayoutSetAttributes col3 renderer3 listStore- $ \row -> [ cellText := BS.unpack $ fromMaybe BS.empty $+ $ \row -> [ cellText := T.pack . BS.unpack . fromMaybe BS.empty $ dscMbTypeStr row, cellTextScale := 0.8, cellTextScaleSet := True ] @@ -244,14 +249,14 @@ liftIO $ writeIORef (searchModeRef search) mode text <- liftIO $ entryGetText entry searchMetaGUI_ text- searchMetaGUI_ :: String -> IDEAction+ searchMetaGUI_ :: Text -> IDEAction searchMetaGUI_ str = do liftIO $ bringPaneToFront search liftIO $ entrySetText entry str scope <- liftIO $ getScope search mode <- liftIO $ getMode search -- let mode' = if length str > 2 then mode else Exact (caseSense mode)- descrs <- if null str+ descrs <- if T.null str then return [] else searchMeta scope str mode liftIO $ do@@ -377,7 +382,7 @@ -- otherwise -> return () {---launchSymbolNavigationDialog :: String -> (Descr -> IDEM ()) -> IDEM ()+launchSymbolNavigationDialog :: Text -> (Descr -> IDEM ()) -> IDEM () launchSymbolNavigationDialog txt act = do dia <- liftIO $ dialogNew win <- getMainWindow
src/IDE/Pane/SourceBuffer.hs view
@@ -1,5 +1,11 @@-{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses,- CPP, TypeSynonymInstances, ScopedTypeVariables, RankNTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fwarn-unused-imports #-} ----------------------------------------------------------------------------- --@@ -23,6 +29,7 @@ , maybeActiveBuf , selectSourceBuf , goToSourceDefinition+, goToSourceDefinition' , goToDefinition , insertInBuffer , replaceHLintSource@@ -100,8 +107,6 @@ import Data.IORef (writeIORef,readIORef,newIORef) import Control.Event (triggerEvent) import IDE.Metainfo.Provider (getSystemInfo, getWorkspaceInfo)-import Distribution.Text (simpleParse)-import Distribution.ModuleName (ModuleName) import Graphics.UI.Gtk (Notebook, clipboardGet, selectionClipboard, dialogAddButton, widgetDestroy, fileChooserGetFilename, widgetShow, fileChooserDialogNew,@@ -133,6 +138,12 @@ import qualified IDE.Command.Print as Print import Control.Monad.Trans.Class (MonadTrans(..)) import System.Log.Logger (debugM)+import Data.Text (Text)+import qualified Data.Text as T+ (length, findIndex, replicate, lines, dropWhileEnd, unlines, strip,+ null, pack, unpack)+import Data.Monoid ((<>))+import qualified Data.Text.IO as T (writeFile, readFile) allBuffers :: MonadIDE m => m [IDEBuffer] allBuffers = liftIDE getPanes@@ -150,7 +161,7 @@ return (Just (BufferStateTrans (bufferName p) text offset)) Just fn -> return (Just (BufferState fn offset)) recoverState pp (BufferState n i) = do- mbbuf <- newTextBuffer pp (takeFileName n) (Just n)+ mbbuf <- newTextBuffer pp (T.pack $ takeFileName n) (Just n) case mbbuf of Just (IDEBuffer {sourceView=v}) -> do ideR <- ask@@ -230,29 +241,38 @@ prefs <- readIDE prefs pp <- getBestPathForId "*Buffer" liftIO $ debugM "lekash" "selectSourceBuf calling newTextBuffer"- nbuf <- newTextBuffer pp (takeFileName fpc) (Just fpc)+ nbuf <- newTextBuffer pp (T.pack $ takeFileName fpc) (Just fpc) liftIO $ debugM "lekash" "selectSourceBuf newTextBuffer returned" return nbuf else do- ideMessage Normal ((__ "File path not found ") ++ fpc)+ ideMessage Normal ((__ "File path not found ") <> T.pack fpc) return Nothing goToDefinition :: Descr -> IDEAction goToDefinition idDescr = do+ mbWorkspaceInfo <- getWorkspaceInfo mbSystemInfo <- getSystemInfo- let mbSourcePath1 = case mbWorkspaceInfo of- Nothing -> Nothing- Just (sc, _) -> sourcePathFromScope sc- let mbSourcePath2 = case mbSourcePath1 of- Just sp -> Just sp- Nothing -> case mbSystemInfo of- Just si -> sourcePathFromScope si- Nothing -> Nothing- when (isJust mbSourcePath2) $- goToSourceDefinition (fromJust $ mbSourcePath2) (dscMbLocation idDescr) >> return ()- return ()- where+ let mbPackagePath = (mbWorkspaceInfo >>= (packagePathFromScope . fst))+ <|> (mbSystemInfo >>= packagePathFromScope)+ mbSourcePath = (mbWorkspaceInfo >>= (sourcePathFromScope . fst))+ <|> (mbSystemInfo >>= sourcePathFromScope)++ liftIO . debugM "leksah" $ show (mbPackagePath, dscMbLocation idDescr, mbSourcePath)+ case (mbPackagePath, dscMbLocation idDescr, mbSourcePath) of+ (Just packagePath, Just loc, _) -> goToSourceDefinition (dropFileName packagePath) loc >> return ()+ (_, Just loc, Just sourcePath) -> goToSourceDefinition' sourcePath loc >> return ()+ (_, _, Just sp) -> selectSourceBuf sp >> return ()+ _ -> return ()+ where+ packagePathFromScope :: GenScope -> Maybe FilePath+ packagePathFromScope (GenScopeC (PackScope l _)) =+ case dscMbModu idDescr of+ Just mod -> case (pack mod) `Map.lookup` l of+ Just pack -> pdMbSourcePath pack+ Nothing -> Nothing+ Nothing -> Nothing+ sourcePathFromScope :: GenScope -> Maybe FilePath sourcePathFromScope (GenScopeC (PackScope l _)) = case dscMbModu idDescr of@@ -265,35 +285,38 @@ Nothing -> Nothing Nothing -> Nothing -goToSourceDefinition :: FilePath -> Maybe Location -> IDEM (Maybe IDEBuffer)-goToSourceDefinition fp dscMbLocation = do--- liftIO $ putStrLn $ "goToSourceDefinition " ++ fp- mbBuf <- selectSourceBuf fp- when (isJust mbBuf && isJust dscMbLocation) $- inActiveBufContext () $ \_ sv ebuf _ _ -> do- let location = fromJust dscMbLocation- liftIO $ debugM "lekash" "goToSourceDefinition calculating range"- lines <- getLineCount ebuf- iterTemp <- getIterAtLine ebuf (max 0 (min (lines-1)- ((locationSLine location) -1)))- chars <- getCharsInLine iterTemp- iter <- atLineOffset iterTemp (max 0 (min (chars-1) (locationSCol location -1)))- iter2Temp <- getIterAtLine ebuf (max 0 (min (lines-1)- ((locationELine location) -1)))- chars2 <- getCharsInLine iter2Temp- iter2 <- atLineOffset iter2Temp (max 0 (min (chars2-1) (locationECol location)))- -- ### we had a problem before using this idleAdd thing- ideR <- ask- liftIO . (`idleAdd` priorityDefaultIdle) . (`reflectIDE` ideR) $ do- liftIO $ debugM "lekash" "goToSourceDefinition triggered selectRange"- selectRange ebuf iter iter2- liftIO $ debugM "lekash" "goToSourceDefinition triggered scrollToIter"- scrollToIter sv iter 0.0 (Just (0.3,0.3))- return False- return ()+goToSourceDefinition :: FilePath -> Location -> IDEM (Maybe IDEBuffer)+goToSourceDefinition packagePath loc = do+ goToSourceDefinition' (packagePath </> locationFile loc) loc++goToSourceDefinition' :: FilePath -> Location -> IDEM (Maybe IDEBuffer)+goToSourceDefinition' sourcePath Location{..} = do+ mbBuf <- selectSourceBuf sourcePath+ case mbBuf of+ Just buf -> do+ inActiveBufContext () $ \_ sv ebuf _ _ -> do+ liftIO $ debugM "lekash" "goToSourceDefinition calculating range"+ lines <- getLineCount ebuf+ iterTemp <- getIterAtLine ebuf (max 0 (min (lines-1)+ (locationSLine -1)))+ chars <- getCharsInLine iterTemp+ iter <- atLineOffset iterTemp (max 0 (min (chars-1) (locationSCol -1)))+ iter2Temp <- getIterAtLine ebuf (max 0 (min (lines-1) (locationELine -1)))+ chars2 <- getCharsInLine iter2Temp+ iter2 <- atLineOffset iter2Temp (max 0 (min (chars2-1) locationECol))+ -- ### we had a problem before using this idleAdd thing+ ideR <- ask+ liftIO . (`idleAdd` priorityDefaultIdle) . (`reflectIDE` ideR) $ do+ liftIO $ debugM "lekash" "goToSourceDefinition triggered selectRange"+ selectRange ebuf iter iter2+ liftIO $ debugM "lekash" "goToSourceDefinition triggered scrollToIter"+ scrollToIter sv iter 0.0 (Just (0.3,0.3))+ return False+ return ()+ Nothing -> return () return mbBuf -replaceHLintSource :: FilePath -> Int -> Int -> Int -> Int -> String -> IDEAction+replaceHLintSource :: FilePath -> Int -> Int -> Int -> Int -> Text -> IDEAction replaceHLintSource file lineS columnS lineE columnE to = do mbBuf <- selectSourceBuf file case mbBuf of@@ -340,8 +363,8 @@ contextRefs <- readIDE contextRefs prefs <- readIDE prefs inBufContext () buf $ \_ sv ebuf buf _ -> do- let tagName = (show $ logRefType logRef) ++ show index- liftIO . debugM "lekash" $ "markRefInSourceBuf getting or creating tag " ++ tagName+ let tagName = T.pack $ show (logRefType logRef) ++ show index+ liftIO . debugM "lekash" . T.unpack $ "markRefInSourceBuf getting or creating tag " <> tagName tagTable <- getTagTable ebuf mbTag <- lookupTag tagTable tagName case mbTag of@@ -406,7 +429,7 @@ return False return () -newTextBuffer :: PanePath -> String -> Maybe FilePath -> IDEM (Maybe IDEBuffer)+newTextBuffer :: PanePath -> Text -> Maybe FilePath -> IDEM (Maybe IDEBuffer) newTextBuffer panePath bn mbfn = do cont <- case mbfn of Nothing -> return True@@ -420,7 +443,7 @@ (ind,rbn) <- figureOutPaneName bn 0 buildThisPane panePath nb (builder' bs mbfn ind bn rbn ct prefs) else do- ideMessage Normal ((__ "File does not exist ") ++ (fromJust mbfn))+ ideMessage Normal ((__ "File does not exist ") <> (T.pack $ fromJust mbfn)) return Nothing data CharacterCategory = IdentifierCharacter | SpaceCharacter | SyntaxCharacter@@ -435,8 +458,8 @@ builder' :: Bool -> Maybe FilePath -> Int ->- String ->- String ->+ Text ->+ Text -> CandyTable -> Prefs -> PanePath ->@@ -447,12 +470,12 @@ -- load up and display a file (fileContents,modTime) <- case mbfn of Just fn -> do- fc <- liftIO $ UTF8.readFile fn+ fc <- liftIO $ T.readFile fn mt <- liftIO $ getModificationTime fn return (fc,Just mt) Nothing -> return ("\n",Nothing) - case textEditor prefs of+ case textEditorType prefs of "GtkSourceView" -> newGtkBuffer mbfn fileContents >>= makeBuffer modTime "Yi" -> newYiBuffer mbfn fileContents >>= makeBuffer modTime "CodeMirror" -> newCMBuffer mbfn fileContents >>= makeBuffer modTime@@ -547,10 +570,10 @@ (si1,si2) <- getSelectionBounds ebuf sTxt <- getCandylessPart candy' ebuf si1 si2- let strippedSTxt = strip' sTxt- case strippedSTxt of- [] -> return ()- _ -> do+ let strippedSTxt = T.strip sTxt+ if T.null strippedSTxt+ then return ()+ else do bi1 <- getStartIter ebuf bi2 <- getEndIter ebuf forwardApplying bi1 strippedSTxt (Just si1) tagName ebuf@@ -613,31 +636,18 @@ createHyperLinkSupport sv sw (\ctrl shift iter -> do (beg, en) <- getIdentifierUnderCursorFromIter (iter, iter) return (beg, if ctrl then en else beg)) (\_ shift' slice -> do- when (slice /= []) $ do+ unless (T.null slice) $ do -- liftIO$ print ("slice",slice) triggerEventIDE (SelectInfo slice shift') return () ) return (Just buf,concat [ids1, ids2, ids3, ids4, ids5, ids6, ids7])- wschars' :: String- wschars' = " \t\r\n" - strip' :: String -> String- strip' = lstrip' . rstrip'-- lstrip' :: String -> String- lstrip' s = case s of- [] -> []- (x:xs) -> if elem x wschars'- then lstrip' xs- else s- rstrip' :: String -> String- rstrip' = reverse . lstrip' . reverse forwardApplying :: TextEditor editor => EditorIter editor- -> String -- txt+ -> Text -- txt -> Maybe (EditorIter editor)- -> String -- tagname+ -> Text -- tagname -> EditorBuffer editor -> IDEM () forwardApplying tI txt mbTi tagName ebuf = do@@ -720,7 +730,7 @@ load <- readIDE (autoLoad . prefs) if load then do- ideMessage Normal $ (__ "Auto Loading ") ++ fn+ ideMessage Normal $ (__ "Auto Loading ") <> T.pack fn revert buf return (False, True) else do@@ -730,7 +740,7 @@ (Just window) [] MessageQuestion ButtonsNone- ((__"File \"") ++ name ++ (__ "\" has changed on disk."))+ ((__"File \"") <> name <> (__ "\" has changed on disk.")) dialogAddButton md (__ "_Load From Disk") (ResponseUser 1) dialogAddButton md (__ "_Always Load From Disk") (ResponseUser 2) dialogAddButton md (__ "_Don't Load") (ResponseUser 3)@@ -766,7 +776,7 @@ nmt <- getModificationTime fn writeIORef (modTime buf) (Just nmt)) (\(e:: SomeException) -> do- sysMessage Normal (show e)+ sysMessage Normal (T.pack $ show e) return ()) fileRevert :: IDEAction@@ -785,7 +795,7 @@ fc <- liftIO $ UTF8.readFile fn mt <- liftIO $ getModificationTime fn beginNotUndoableAction buffer- setText buffer fc+ setText buffer $ T.pack fc if useCandy then modeTransformToCandy (mode buf) (modeEditInCommentOrString (mode buf)) buffer@@ -904,7 +914,7 @@ nb ideBuf useCandy candy fn closePane ideBuf cfn <- liftIO $ myCanonicalizePath fn- newTextBuffer panePath (takeFileName cfn) (Just cfn)+ newTextBuffer panePath (T.pack $ takeFileName cfn) (Just cfn) ) ideR return True _ -> return False@@ -914,16 +924,14 @@ buf <- getBuffer $ sv text <- getCandylessText candyTable buf let text' = if removeTBlanks- then unlines $ map removeTrailingBlanks $lines text+ then T.unlines $ map (T.dropWhileEnd $ \c -> c == ' ') $ T.lines text else text- succ <- liftIO $ E.catch (do UTF8.writeFile fn text'; return True)+ succ <- liftIO $ E.catch (do T.writeFile fn text'; return True) (\(e :: SomeException) -> do- sysMessage Normal (show e)+ sysMessage Normal . T.pack $ show e return False) setModified buf (not succ) markLabelAsChanged nb ideBuf- removeTrailingBlanks :: String -> String- removeTrailingBlanks = reverse . dropWhile (\c -> c == ' ') . reverse fileSave :: Bool -> IDEM Bool fileSave query = inActiveBufContext False $ fileSaveBuffer query@@ -978,8 +986,8 @@ MessageQuestion ButtonsCancel ((__ "Save changes to document: ")- ++ paneName currentBuffer- ++ "?")+ <> paneName currentBuffer+ <> "?") dialogAddButton md (__ "_Save") ResponseYes dialogAddButton md (__ "_Don't Save") ResponseNo set md [ windowWindowPosition := WinPosCenterOnParent ]@@ -1127,7 +1135,7 @@ where reallyOpen prefs fpc = do pp <- getBestPathForId "*Buffer"- newTextBuffer pp (takeFileName fpc) (Just fpc)+ newTextBuffer pp (T.pack $ takeFileName fpc) (Just fpc) return () filePrint :: IDEAction@@ -1141,11 +1149,11 @@ md <- messageDialogNew (Just window) [] MessageQuestion ButtonsNone- ("Print document: "- ++ pName- ++ "?")- dialogAddButton md "_Print" ResponseYes- dialogAddButton md "_Don't Print" ResponseNo+ (__"Print document: "+ <> pName+ <> "?")+ dialogAddButton md (__"_Print") ResponseYes+ dialogAddButton md (__"_Don't Print") ResponseNo set md [ windowWindowPosition := WinPosCenterOnParent ] resp <- dialogRun md widgetDestroy md@@ -1166,12 +1174,12 @@ md <- messageDialogNew (Just window) [] MessageQuestion ButtonsNone- ("Save changes to document: "- ++ pName- ++ "?")- dialogAddButton md "_Save" ResponseYes- dialogAddButton md "_Don't Save" ResponseNo- dialogAddButton md "_Cancel Printing" ResponseCancel+ (__"Save changes to document: "+ <> pName+ <> "?")+ dialogAddButton md (__"_Save") ResponseYes+ dialogAddButton md (__"_Don't Save") ResponseNo+ dialogAddButton md (__"_Cancel Printing") ResponseCancel set md [ windowWindowPosition := WinPosCenterOnParent ] resp <- dialogRun md widgetDestroy md@@ -1191,7 +1199,7 @@ Just name -> do status <- liftIO $ Print.print name case status of- Left error -> liftIO $ showDialog (show error) MessageError+ Left error -> liftIO $ showDialog (T.pack $ show error) MessageError Right _ -> liftIO $ showDialog "Print job has been sent successfully" MessageInfo return () Nothing -> return ()@@ -1237,7 +1245,7 @@ editShiftLeft :: IDEAction editShiftLeft = do prefs <- readIDE prefs- let str = map (\_->' ') [1 .. (tabWidth prefs)]+ let str = T.replicate (tabWidth prefs) " " b <- canShiftLeft str prefs if b then do@@ -1260,7 +1268,7 @@ editShiftRight :: IDEAction editShiftRight = do prefs <- readIDE prefs- let str = map (\_->' ') [1 .. (tabWidth prefs)]+ let str = T.replicate (tabWidth prefs) " " doForSelectedLines [] $ \ebuf lineNr -> do sol <- getIterAtLine ebuf lineNr insert ebuf sol str@@ -1279,7 +1287,7 @@ sol <- getIterAtLine ebuf lineNr eol <- forwardToLineEndC sol line <- getText ebuf sol eol True- return (lineNr, elemIndex char line)+ return (lineNr, T.findIndex (==char) line) alignChar :: Map Int (Maybe Int) -> Int -> IDEM () alignChar positions alignTo = do doForSelectedLines [] $ \ebuf lineNr -> do@@ -1287,7 +1295,7 @@ Just (Just n) -> do sol <- getIterAtLine ebuf lineNr insertLoc <- forwardCharsC sol n- insert ebuf insertLoc (replicate (alignTo - n) ' ')+ insert ebuf insertLoc (T.replicate (alignTo - n) " ") _ -> return () return () @@ -1320,7 +1328,7 @@ triggerEventIDE UpdateRecent return () -selectedText :: IDEM (Maybe String)+selectedText :: IDEM (Maybe Text) selectedText = do candy' <- readIDE candy inActiveBufContext Nothing $ \_ _ ebuf currentBuffer _ -> do@@ -1332,7 +1340,7 @@ return $ Just text else return Nothing -selectedTextOrCurrentLine :: IDEM (Maybe String)+selectedTextOrCurrentLine :: IDEM (Maybe Text) selectedTextOrCurrentLine = do candy' <- readIDE candy inActiveBufContext Nothing $ \_ _ ebuf currentBuffer _ -> do@@ -1360,7 +1368,7 @@ else return (line, lineOffset) return $ Just res -insertTextAfterSelection :: String -> IDEAction+insertTextAfterSelection :: Text -> IDEAction insertTextAfterSelection str = do candy' <- readIDE candy inActiveBufContext () $ \_ _ ebuf currentBuffer _ -> do@@ -1372,7 +1380,7 @@ mark <- createMark ebuf i True insert ebuf i realString i1 <- getIterAtMark ebuf mark- i2 <- forwardCharsC i1 (length str)+ i2 <- forwardCharsC i1 (T.length str) selectRange ebuf i1 i2 -- | Returns the package, to which this buffer belongs, if possible
src/IDE/Pane/Trace.hs view
@@ -53,11 +53,15 @@ import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.IO.Class (MonadIO(..)) import IDE.Utils.GUIUtils (treeViewContextMenu, __)-import Text.Printf (printf) import Data.Text (Text) import Data.Monoid ((<>))-import qualified Data.Text as T (unpack)+import qualified Data.Text as T (pack, unpack)+import qualified Text.Printf as S (printf)+import Text.Printf (PrintfType) +printf :: PrintfType r => Text -> r+printf = S.printf . T.unpack+ -- | A debugger pane description -- data IDETrace = IDETrace {@@ -72,7 +76,7 @@ data TraceHist = TraceHist { thSelected :: Bool, thIndex :: Int,- thFunction :: String,+ thFunction :: Text, thPosition :: SrcSpan } @@ -109,7 +113,7 @@ renderer0 <- cellRendererToggleNew col0 <- treeViewColumnNew- treeViewColumnSetTitle col0 ""+ treeViewColumnSetTitle col0 (""::Text) treeViewColumnSetSizing col0 TreeViewColumnAutosize treeViewColumnSetResizable col0 False treeViewColumnSetReorderable col0 True@@ -127,7 +131,7 @@ treeViewAppendColumn treeView col1 cellLayoutPackStart col1 renderer1 False cellLayoutSetAttributes col1 renderer1 tracepoints- $ \row -> [ cellText := show (thIndex row)]+ $ \row -> [ cellText := T.pack $ show (thIndex row)] renderer2 <- cellRendererTextNew col2 <- treeViewColumnNew@@ -149,7 +153,7 @@ treeViewAppendColumn treeView col3 cellLayoutPackStart col3 renderer3 False cellLayoutSetAttributes col3 renderer3 tracepoints- $ \row -> [ cellText := displaySrcSpan (thPosition row)]+ $ \row -> [ cellText := T.pack $ displaySrcSpan (thPosition row)] treeViewSetHeadersVisible treeView True sel <- treeViewGetSelection treeView@@ -239,24 +243,24 @@ tracesParser :: CharParser () [TraceHist] tracesParser = try (do whiteSpace- symbol (__ "Empty history.")+ symbol (T.unpack $ __ "Empty history.") skipMany anyChar eof return []) <|> do traces <- many (try traceParser) whiteSpace- symbol (__ "<end of history>")+ symbol (T.unpack $ __ "<end of history>") eof return traces <|> do whiteSpace- symbol (__ "Not stopped at a breakpoint")+ symbol (T.unpack $ __ "Not stopped at a breakpoint") skipMany anyChar eof return [] <?>- __ "traces parser"+ (T.unpack $ __ "traces parser") traceParser :: CharParser () TraceHist traceParser = do@@ -264,13 +268,13 @@ index <- int colon optional (symbol "\ESC[1m")- function <- many (noneOf "(\ESC")+ function <- T.pack <$> many (noneOf "(\ESC") optional (symbol "\ESC[0m") symbol "(" span <- srcSpanParser symbol ")" return (TraceHist False index function span)- <?> __ "trace parser"+ <?> (T.unpack $ __ "trace parser") lexer = P.makeTokenParser emptyDef colon = P.colon lexer
src/IDE/Pane/Variables.hs view
@@ -53,7 +53,8 @@ import IDE.Utils.GUIUtils (treeViewContextMenu, __) import Data.Text (Text) import Data.Monoid ((<>))-import qualified Data.Text as T (unpack)+import qualified Data.Text as T (pack, unpack)+import Control.Applicative ((<$>)) -- | A variables pane description --@@ -64,9 +65,9 @@ } deriving Typeable data VarDescription = VarDescription {- varName :: String-, varType :: String-, varValue :: String}+ varName :: Text+, varType :: Text+, varValue :: Text} data VariablesState = VariablesState { } deriving(Eq,Ord,Read,Show,Typeable)@@ -162,7 +163,7 @@ to <- CL.consume liftIO $ postGUIAsync $ case parse variablesParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (show e)+ Left e -> sysMessage Normal (T.pack $ show e) Right triples -> do treeStoreClear (variables var) mapM_ (insertBreak (variables var))@@ -179,7 +180,7 @@ to <- CL.consume liftIO $ postGUIAsync $ case parse variablesParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (show e)+ Left e -> sysMessage Normal (T.pack $ show e) Right triples -> do treeStoreClear (variables var) mapM_ (insertBreak (variables var))@@ -214,11 +215,11 @@ variableParser :: CharParser () VarDescription variableParser = do whiteSpace- varName <- many (noneOf ":")+ varName <- T.pack <$> many (noneOf ":") symbol "::"- typeStr <- many (noneOf "=")+ typeStr <- T.pack <$> many (noneOf "=") char '='- value <- many (+ value <- T.pack <$> many ( noneOf "\n" <|> try (do r <- char '\n'@@ -228,20 +229,20 @@ return (VarDescription varName typeStr value) <?> "variableParser" -valueParser :: CharParser () String+valueParser :: CharParser () Text valueParser = do whiteSpace many (noneOf "=") char '='- many anyChar+ T.pack <$> many anyChar <?> "valueParser" -typeParser :: CharParser () String+typeParser :: CharParser () Text typeParser = do whiteSpace many (noneOf ":") symbol "::"- many anyChar+ T.pack <$> many anyChar <?> "typeParser" @@ -285,38 +286,38 @@ forceVariable :: VarDescription -> TreePath -> TreeStore VarDescription -> IDEAction forceVariable varDescr path treeStore = packageTry $ tryDebug $ do- debugCommand' (":force " ++ varName varDescr) $ do+ debugCommand' (":force " <> varName varDescr) $ do to <- CL.consume liftIO $ postGUIAsync $ case parse valueParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (show e)+ Left e -> sysMessage Normal (T.pack $ show e) Right value -> do var <- treeStoreGetValue treeStore path treeStoreSetValue treeStore path var{varValue = value}- debugCommand' (":type " ++ varName varDescr) $ do+ debugCommand' (":type " <> varName varDescr) $ do to <- CL.consume liftIO $ postGUIAsync $ case parse typeParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (show e)+ Left e -> sysMessage Normal (T.pack $ show e) Right typ -> do var <- treeStoreGetValue treeStore path treeStoreSetValue treeStore path var{varType = typ} printVariable :: VarDescription -> TreePath -> TreeStore VarDescription -> IDEAction printVariable varDescr path treeStore = packageTry $ tryDebug $ do- debugCommand' (":print " ++ varName varDescr) $ do+ debugCommand' (":print " <> varName varDescr) $ do to <- CL.consume liftIO $ postGUIAsync $ case parse valueParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (show e)+ Left e -> sysMessage Normal (T.pack $ show e) Right value -> do var <- treeStoreGetValue treeStore path treeStoreSetValue treeStore path var{varValue = value}- debugCommand' (":type " ++ varName varDescr) $ do+ debugCommand' (":type " <> varName varDescr) $ do to <- CL.consume liftIO $ postGUIAsync $ case parse typeParser "" . T.unpack $ selectString to of- Left e -> sysMessage Normal (show e)+ Left e -> sysMessage Normal (T.pack $ show e) Right typ -> do var <- treeStoreGetValue treeStore path treeStoreSetValue treeStore path var{varType = typ}
src/IDE/Pane/WebKit/Documentation.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.WebKit.Documentation@@ -32,6 +33,7 @@ (scrolledWindowSetShadowType, scrolledWindowSetPolicy, scrolledWindowNew, castToWidget, ScrolledWindow) import Data.Typeable (Typeable)+import Data.Text (Text) import IDE.Core.Types (IDEAction, IDEM) import Control.Monad.IO.Class (MonadIO(..)) import Graphics.UI.Frame.ViewFrame (getNotebook)@@ -67,7 +69,7 @@ data DocumentationState = DocumentationState { zoom :: Float- , uri :: Maybe String+ , uri :: Maybe Text } deriving(Eq,Ord,Read,Show,Typeable) instance Pane IDEDocumentation IDEM@@ -137,7 +139,7 @@ getDocumentation Nothing = forceGetPane (Right "*Doc") getDocumentation (Just pp) = forceGetPane (Left pp) -loadDoc :: String -> IDEAction+loadDoc :: Text -> IDEAction loadDoc uri = do #ifdef WEBKITGTK doc <- getDocumentation Nothing
src/IDE/Pane/WebKit/Output.hs view
@@ -1,9 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.WebKit.Output@@ -33,6 +34,7 @@ boxPackStart, entrySetText, Entry, VBox, entryNew, vBoxNew, postGUISync, scrolledWindowSetPolicy, scrolledWindowNew, castToWidget, ScrolledWindow)+import IDE.Utils.GUIUtils import Data.Typeable (Typeable) import IDE.Core.Types (IDEAction, IDEM, IDE(..)) import Control.Monad.IO.Class (MonadIO(..))@@ -68,6 +70,8 @@ import Graphics.UI.Gtk.WebKit.WebView (loadCommitted, webViewGetUri) import Graphics.UI.Gtk.WebKit.WebFrame (webFrameGetUri)+import Data.Text (Text)+import qualified Data.Text as T (unpack, pack) data IDEOutput = IDEOutput { vbox :: VBox@@ -117,7 +121,7 @@ builder pp nb windows = reifyIDE $ \ ideR -> do vbox <- vBoxNew False 0 uriEntry <- entryNew- entrySetText uriEntry "http://"+ entrySetText uriEntry ("http://" :: Text) scrolledView <- scrolledWindowNew Nothing Nothing scrolledWindowSetShadowType scrolledView ShadowIn boxPackStart vbox uriEntry PackNatural 0@@ -151,7 +155,7 @@ cid3 <- on webView populatePopup $ \ menu -> do alwaysHtml <- readIORef alwaysHtmlRef- action <- toggleActionNew "AlwaysHTML" "Always HTML" Nothing Nothing+ action <- toggleActionNew "AlwaysHTML" (__"Always HTML") Nothing Nothing item <- castToMenuItem <$> actionCreateMenuItem action item `on` menuItemActivate $ writeIORef alwaysHtmlRef $ not alwaysHtml toggleActionSetActive action alwaysHtml@@ -188,28 +192,28 @@ getOutputPane Nothing = forceGetPane (Right "*Out") getOutputPane (Just pp) = forceGetPane (Left pp) -getValueUri :: IO String+getValueUri :: IO Text getValueUri = do dataDir <- leksahOrPackageDir "pretty-show" getDataDir- return $ "file://"+ return . T.pack $ "file://" ++ (case dataDir of ('/':_) -> dataDir _ -> '/':dataDir) ++ "/value.html" -setOutput :: String -> String -> IDEAction+setOutput :: Text -> Text -> IDEAction setOutput command str = do #ifdef WEBKITGTK out <- getOutputPane Nothing liftIO $ do- entrySetText (uriEntry out) (show command)+ entrySetText (uriEntry out) (T.pack $ show command) uri <- getValueUri alwaysHtml <- readIORef $ alwaysHtmlRef out let view = webView out- html = case (alwaysHtml, parseValue str) of- (False, Just value) -> valToHtmlPage defaultHtmlOpts value+ html = case (alwaysHtml, parseValue $ T.unpack str) of+ (False, Just value) -> T.pack $ valToHtmlPage defaultHtmlOpts value _ -> str- webViewLoadString view html Nothing Nothing uri+ webViewLoadString view html Nothing uri #else return () #endif@@ -220,11 +224,11 @@ out <- getOutputPane Nothing let view = webView out liftIO $ do- entrySetText (uriEntry out) uri+ entrySetText (uriEntry out) (T.pack uri) currentUri <- webViewGetUri view- if Just uri == currentUri+ if Just (T.pack uri) == currentUri then webViewReload view- else webViewLoadUri view uri+ else webViewLoadUri view (T.pack uri) #else return () #endif
src/IDE/Pane/Workspace.hs view
@@ -1,5 +1,9 @@-{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances,- MultiParamTypeClasses, DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Workspace@@ -40,11 +44,13 @@ import System.Log.Logger (debugM) import qualified Data.Function as F (on) import System.FilePath (takeDirectory, takeBaseName, takeFileName)+import Data.Text (Text)+import qualified Data.Text as T (pack) -- | Workspace pane state -- -type WorkspaceRecord = (IDEPackage, Maybe String)+type WorkspaceRecord = (IDEPackage, Maybe Text) data IDEWorkspace = IDEWorkspace { scrolledView :: ScrolledWindow@@ -79,7 +85,7 @@ treeViewSetModel treeView treeStore renderer0 <- cellRendererPixbufNew- set renderer0 [ newAttrFromMaybeStringProperty "stock-id" := Nothing ]+ set renderer0 [ newAttrFromMaybeStringProperty "stock-id" := (Nothing :: Maybe Text) ] renderer1 <- cellRendererTextNew col1 <- treeViewColumnNew@@ -107,7 +113,7 @@ treeViewAppendColumn treeView col2 cellLayoutPackStart col2 renderer2 True cellLayoutSetAttributes col2 renderer2 treeStore- $ \row -> [ cellText := file row ]+ $ \row -> [ cellText := T.pack $ file row ] treeViewSetHeadersVisible treeView True sel <- treeViewGetSelection treeView@@ -144,7 +150,7 @@ getSelectionTree :: TreeView -> TreeStore (Bool, WorkspaceRecord)- -> IO (Maybe (Bool, IDEPackage, Maybe String))+ -> IO (Maybe (Bool, IDEPackage, Maybe Text)) getSelectionTree treeView treeStore = do liftIO $ debugM "leksah" "getSelectionTree" treeSelection <- treeViewGetSelection treeView
src/IDE/PaneGroups.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.PaneGroups
src/IDE/Sandbox.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Sandbox@@ -20,15 +21,15 @@ ) where import Graphics.UI.Gtk (Window)+import Control.Applicative ((<$>), (<*>)) import Control.Monad (when, void) import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Reader (ask) import System.Exit (ExitCode(..)) import System.FilePath (dropFileName)-import qualified Data.Conduit as C (Sink)+import qualified Data.Conduit as C (Sink, ZipSink(..), getZipSink) import qualified Data.Conduit.List as CL (fold)-import qualified Data.Conduit.Util as CU (zipSinks) import IDE.Utils.Tool (ToolOutput(..)) import IDE.Utils.GUIUtils (__, chooseDir) import IDE.Core.State (PackageAction, readIDE, prefs, ipdBuildDir, getMainWindow,@@ -39,6 +40,8 @@ import IDE.Pane.PackageEditor (choosePackageFile) import IDE.Workspaces (workspaceTryQuiet) import IDE.Package (refreshPackage)+import Data.Monoid ((<>))+import qualified Data.Text as T (pack) -- | Get the last item sinkLast = CL.fold (\_ a -> Just a) Nothing@@ -46,7 +49,7 @@ logSandbox :: IDEPackage -> LogLaunch -> C.Sink ToolOutput IDEM () logSandbox package logLaunch = do let log = logOutput logLaunch- (mbLastOutput, _) <- CU.zipSinks sinkLast log+ mbLastOutput <- C.getZipSink $ const <$> C.ZipSink sinkLast <*> C.ZipSink log when (mbLastOutput == Just (ToolExit ExitSuccess)) . lift $ workspaceTryQuiet (runPackage (void $ refreshPackage log) package) @@ -72,7 +75,7 @@ Just dir -> do logLaunch <- getDefaultLogLaunch runExternalTool' (__ "Sandbox Init")- "cabal" ["sandbox", "init", "--sandbox=" ++ dir]+ "cabal" ["sandbox", "init", "--sandbox=" <> T.pack dir] (ipdBuildDir package) (logSandbox package logLaunch) sandboxDelete :: PackageAction@@ -98,6 +101,6 @@ Just fp -> do logLaunch <- getDefaultLogLaunch runExternalTool' (__ "Sandbox Add Source")- "cabal" (["sandbox", "add-source", fp] ++ ["--snapshot" | snapshot])+ "cabal" (["sandbox", "add-source", T.pack fp] ++ ["--snapshot" | snapshot]) (ipdBuildDir package) (logSandbox package logLaunch)
src/IDE/Session.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Session@@ -72,6 +74,8 @@ import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad (forM_, forM, when) import System.Log.Logger (debugM)+import Data.Text (Text)+import qualified Data.Text as T (pack) -- --------------------------------------------------------------------- -- This needs to be incremented, when the session format changes@@ -159,7 +163,7 @@ data SessionState = SessionState { sessionVersion :: Int- , saveTime :: String+ , saveTime :: Text , layoutS :: PaneLayout , population :: [(Maybe PaneState,PanePath)] , windowSize :: (Int,Int)@@ -167,7 +171,7 @@ , dark :: Bool , completionSize :: (Int,Int) , workspacePath :: Maybe FilePath- , activePaneN :: Maybe String+ , activePaneN :: Maybe Text , toolbarVisibleS :: Bool , findbarState :: (Bool,FindState) , recentOpenedFiles :: [FilePath]@@ -381,7 +385,7 @@ recentWorkspaces' <- readIDE recentWorkspaces let state = SessionState { sessionVersion = theSessionVersion- , saveTime = show timeNow+ , saveTime = T.pack $ show timeNow , layoutS = layout , population = population , windowSize = size@@ -530,7 +534,7 @@ Just st -> return (Just (asPaneState st), fst v)) $ Map.toList paneMap -getActive :: IDEM(Maybe String)+getActive :: IDEM(Maybe FilePath) getActive = do active <- readIDE activePack case active of@@ -582,7 +586,7 @@ liftIO $ debugM "leksah" "recoverSession done" return (toolbarVisibleS sessionSt, (fst . findbarState) sessionSt)) (\ (e :: SomeException) -> do- sysMessage Normal (show e)+ sysMessage Normal (T.pack $ show e) return (True,True)) applyLayout :: PaneLayout -> IDEAction@@ -680,7 +684,7 @@ case mbSettings of Just settings -> liftIO $ settingsSetLongProperty settings- "gtk-application-prefer-dark-theme"+ ("gtk-application-prefer-dark-theme" :: Text) (if dark then 1 else 0) "Leksah" Nothing -> return ()
src/IDE/SourceCandy.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.SourceCandy@@ -18,10 +19,10 @@ , transformToCandy -- :: TextBuffer -> IO () , transformFromCandy -- :: TextBuffer -> IO () , keystrokeCandy -- :: Maybe Char -> TextBuffer -> IO ()-, getCandylessText -- :: TextBuffer -> IO String+, getCandylessText -- :: TextBuffer -> IO Text -, getCandylessPart -- :: CandyTable -> TextBuffer -> TextIter -> TextIter -> IO String-, stringToCandy -- :: CandyTable -> String -> IO String+, getCandylessPart -- :: CandyTable -> TextBuffer -> TextIter -> TextIter -> IO Text+, stringToCandy -- :: CandyTable -> Text -> IO Text , positionToCandy -- :: CandyTable -> TextBuffer -> (Int,Int) -> IO (Int,Int) , positionFromCandy -- :: CandyTable -> TextBuffer -> (Int,Int) -> IO (Int,Int) ) where@@ -38,6 +39,11 @@ import IDE.Core.State import IDE.TextEditor import Control.Monad (unless)+import Data.Text (Text)+import qualified Data.Text as T+ (pack, singleton, replicate, head, takeWhile, isSuffixOf, length,+ index)+import Data.Monoid ((<>)) --------------------------------------------------------------------------------- -- * Implementation@@ -48,7 +54,7 @@ '^','|','-','~','\'','"'] notAfterOp = notBeforeOp -keystrokeCandy :: TextEditor editor => CandyTable -> Maybe Char -> EditorBuffer editor -> (String -> Bool) -> IDEM ()+keystrokeCandy :: TextEditor editor => CandyTable -> Maybe Char -> EditorBuffer editor -> (Text -> Bool) -> IDEM () keystrokeCandy (CT(transformTable,_)) mbc ebuf editInCommentOrString = do cursorMark <- getInsertMark ebuf endIter <- getIterAtMark ebuf cursorMark@@ -65,12 +71,12 @@ unless block $ replace mbc2 cursorMark slice offset transformTable where- -- replace :: Maybe Char -> m -> String -> Int -> [(Bool,String,String)] -> IDEM ()+ -- replace :: Maybe Char -> m -> Text -> Int -> [(Bool,Text,Text)] -> IDEM () replace mbAfterChar cursorMark match offset list = replace' list where replace' [] = return () replace' ((isOp,from,to):rest) =- let beforeChar = match !! (max 0 (length match - (length from + 1)))+ let beforeChar = T.index match (max 0 (T.length match - (T.length from + 1))) beforeOk = not $if isOp then Set.member beforeChar notBeforeOp else Set.member beforeChar notBeforeId@@ -80,10 +86,10 @@ not $if isOp then Set.member afterChar notAfterOp else Set.member afterChar notAfterId- in if isSuffixOf from match && beforeOk && afterOk+ in if T.isSuffixOf from match && beforeOk && afterOk then do beginNotUndoableAction ebuf- start <- getIterAtOffset ebuf (offset - (length from))+ start <- getIterAtOffset ebuf (offset - (T.length from)) end <- getIterAtOffset ebuf offset delete ebuf start end ins <- getIterAtMark ebuf cursorMark@@ -91,7 +97,7 @@ endNotUndoableAction ebuf else replace mbAfterChar cursorMark match offset rest -transformToCandy :: TextEditor editor => CandyTable -> EditorBuffer editor -> (String -> Bool) -> IDEM ()+transformToCandy :: TextEditor editor => CandyTable -> EditorBuffer editor -> (Text -> Bool) -> IDEM () transformToCandy (CT(transformTable,_)) ebuf editInCommentOrString = do beginUserAction ebuf modified <- getModified ebuf@@ -100,7 +106,7 @@ endUserAction ebuf -replaceTo :: TextEditor editor => EditorBuffer editor -> (Bool,String,String) -> Int -> (String -> Bool) -> IDEM ()+replaceTo :: TextEditor editor => EditorBuffer editor -> (Bool,Text,Text) -> Int -> (Text -> Bool) -> IDEM () replaceTo buf (isOp,from,to) offset editInCommentOrString = replaceTo' offset where replaceTo' offset = do@@ -157,7 +163,7 @@ endUserAction ebuf setModified ebuf modified -getCandylessText :: TextEditor editor => CandyTable -> EditorBuffer editor -> IDEM String+getCandylessText :: TextEditor editor => CandyTable -> EditorBuffer editor -> IDEM Text getCandylessText (CT(_,transformTableBack)) ebuf = do i1 <- getStartIter ebuf i2 <- getEndIter ebuf@@ -169,7 +175,7 @@ text2 <- getText workBuffer i1 i2 True return text2 -getCandylessPart :: TextEditor editor => CandyTable -> EditorBuffer editor -> EditorIter editor -> EditorIter editor -> IDEM String+getCandylessPart :: TextEditor editor => CandyTable -> EditorBuffer editor -> EditorIter editor -> EditorIter editor -> IDEM Text getCandylessPart (CT(_,transformTableBack)) ebuf i1 i2 = do text1 <- getText ebuf i1 i2 True workBuffer <- simpleGtkBuffer text1@@ -179,7 +185,7 @@ text2 <- getText workBuffer i1 i2 True return text2 -stringToCandy :: CandyTable -> String -> IDEM String+stringToCandy :: CandyTable -> Text -> IDEM Text stringToCandy candyTable text = do workBuffer <- simpleGtkBuffer text transformToCandy candyTable workBuffer (\ _ -> False)@@ -215,7 +221,7 @@ columnNew <- getLineOffset i4 return (line,columnNew) -replaceFrom :: TextEditor editor => EditorBuffer editor -> (String,String,Int) -> Int -> IDEM ()+replaceFrom :: TextEditor editor => EditorBuffer editor -> (Text,Text,Int) -> Int -> IDEM () replaceFrom buf (to,from,spaces) offset = replaceFrom' offset where replaceFrom' offset = do@@ -231,7 +237,7 @@ iter2 <- getIterAtOffset buf offset iter3 <- getIterAtOffset buf (offset + spaces + 1) slice <- getSlice buf iter2 iter3 True- let l = length (takeWhile (== ' ') slice)+ let l = T.length (T.takeWhile (== ' ') slice) if l > 1 then do iter4 <- atOffset iter3 (offset + l - 1)@@ -242,24 +248,24 @@ insert buf iter to replaceFrom' offset -type CandyTableI = [(String,Char,Bool)]+type CandyTableI = [(Text,Char,Bool)] forthFromTable :: CandyTableI -> CandyTableForth forthFromTable table = map forthFrom table where forthFrom (str,chr,noTrimming) =- let isOp = not (Set.member (head str) notBeforeId)+ let isOp = not (Set.member (T.head str) notBeforeId) from = str- trailingBlanks = replicate (if noTrimming then 0 else length str - 1) ' '- to = chr : trailingBlanks+ trailingBlanks = T.replicate (if noTrimming then 0 else T.length str - 1) (T.singleton ' ')+ to = T.singleton chr <> trailingBlanks in (isOp,from,to) backFromTable :: CandyTableI -> CandyTableBack backFromTable table = map backFrom table where backFrom (str,chr,noTrimming) =- let numTrailingBlanks = if noTrimming then 0 else length str - 1- in (str,[chr],numTrailingBlanks)+ let numTrailingBlanks = if noTrimming then 0 else T.length str - 1+ in (str,T.singleton chr,numTrailingBlanks) ---Candy Parser @@ -280,7 +286,7 @@ parseCandy fn = do res <- parseFromFile candyParser fn case res of- Left pe -> throwIDE $"Error reading candy file " ++ show fn ++ " " ++ show pe+ Left pe -> throwIDE $ "Error reading candy file " <> T.pack (show fn) <> " " <> T.pack (show pe) Right r -> return (CT(forthFromTable r, backFromTable r)) candyParser :: CharParser () CandyTableI@@ -290,7 +296,7 @@ eof return ls -oneCandyParser :: CharParser () (String,Char,Bool)+oneCandyParser :: CharParser () (Text,Char,Bool) oneCandyParser = do toReplace <- toReplaceParser replaceWith <- replaceWithParser@@ -299,12 +305,12 @@ return False) return (toReplace,replaceWith,nt) -toReplaceParser :: CharParser () String+toReplaceParser :: CharParser () Text toReplaceParser = lexeme (do str <- between (char '"') (char '"' <?> "end of string") (many $noneOf "\"")- return str)+ return $ T.pack str) <?> "to replace string" replaceWithParser :: CharParser () Char
src/IDE/Statusbar.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Statusbar@@ -45,7 +46,9 @@ import Graphics.UI.Frame.Panes (IDEPane(..), paneName) import Text.Printf (printf) import Control.Monad.IO.Class (MonadIO(..))-+import Data.Text (Text)+import qualified Data.Text as T (pack, lines, unpack)+import Data.Monoid ((<>)) changeStatusbar :: [StatusbarCompartment] -> IDEAction changeStatusbar = postAsyncIDE . mapM_ changeStatusbar'@@ -63,10 +66,10 @@ changeStatusbar' (CompartmentPane Nothing) = do sb <- getSBActivePane liftIO $ statusbarPop sb 1- liftIO $ statusbarPush sb 1 ""+ liftIO $ statusbarPush sb 1 ("" :: Text) return () changeStatusbar' (CompartmentState string) = do- let realStr = if '\n' `elem` string then head (lines string) ++ " ..." else string+ let realStr = if '\n' `elem` T.unpack string then head (T.lines string) <> " ..." else string sb <- getSBErrors liftIO $ statusbarPop sb 1 liftIO $ statusbarPush sb 1 realStr@@ -76,17 +79,17 @@ window <- getMainWindow liftIO $ statusbarPop sb 1 liftIO $ statusbarPush sb 1 string- liftIO $ set window [ windowTitle := "Leksah: " ++ string ]+ liftIO $ set window [ windowTitle := "Leksah: " <> string ] return () changeStatusbar' (CompartmentBufferPos (line,col)) = do sb <- getStatusbarLC liftIO $ statusbarPop sb 1- liftIO $ statusbarPush sb 1 $ printf "Ln %4d, Col %3d" (line + 1) (col + 1)+ liftIO $ statusbarPush sb 1 (T.pack $ printf "Ln %4d, Col %3d" (line + 1) (col + 1)) return () changeStatusbar' (CompartmentOverlay modi) = do sb <- getStatusbarIO liftIO $ statusbarPop sb 1- liftIO $ statusbarPush sb 1 $ if modi then "OVR" else "INS"+ liftIO $ statusbarPush sb 1 $ if modi then "OVR" else ("INS" :: Text) return () changeStatusbar' (CompartmentBuild bool) = do im <- getImBuild@@ -101,39 +104,39 @@ buildStatusbar :: IO HBox buildStatusbar = do sblk <- statusbarNew- widgetSetName sblk "statusBarSpecialKeys"+ widgetSetName sblk ("statusBarSpecialKeys" :: Text) widgetSetSizeRequest sblk 150 (-1) sbap <- statusbarNew- widgetSetName sbap "statusBarActivePane"+ widgetSetName sbap ("statusBarActivePane" :: Text) widgetSetSizeRequest sbap 150 (-1) sbapr <- statusbarNew- widgetSetName sbapr "statusBarActiveProject"+ widgetSetName sbapr ("statusBarActiveProject" :: Text) widgetSetSizeRequest sbapr 150 (-1) sbe <- statusbarNew- widgetSetName sbe "statusBarErrors"+ widgetSetName sbe ("statusBarErrors" :: Text) widgetSetSizeRequest sbe 150 (-1) sblc <- statusbarNew- widgetSetName sblc "statusBarLineColumn"+ widgetSetName sblc ("statusBarLineColumn" :: Text) widgetSetSizeRequest sblc 150 (-1) sbio <- statusbarNew- widgetSetName sbio "statusBarInsertOverwrite"+ widgetSetName sbio ("statusBarInsertOverwrite" :: Text) widgetSetSizeRequest sbio 60 (-1) buildImage <- imageNewFromStock "ide_empty" IconSizeMenu- widgetSetName buildImage "buildImage"+ widgetSetName buildImage ("buildImage" :: Text) imageSetPixelSize buildImage 16 collectImage <- imageNewFromStock "ide_empty" IconSizeMenu- widgetSetName collectImage "collectImage"+ widgetSetName collectImage ("collectImage" :: Text) imageSetPixelSize collectImage 16 hb <- hBoxNew False 1- widgetSetName hb "statusBox"+ widgetSetName hb ("statusBox" :: Text) boxPackStart hb sblk PackGrow 0 boxPackStart hb sbap PackGrow 0 boxPackStart hb sbapr PackGrow 0
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.SymbolNavigation@@ -47,6 +48,8 @@ import Control.Monad.Reader.Class (MonadReader(..)) import IDE.Core.State (reflectIDE) import Control.Applicative ((<$>))+import Data.Text (Text)+import qualified Data.Text as T (length) data Locality = LocalityPackage | LocalityWorkspace | LocalitySystem -- in which category symbol is located deriving (Ord,Eq,Show)@@ -57,7 +60,7 @@ => EditorView editor -- ^ source buffer view -> ScrolledWindow -- ^ container window -> (Bool -> Bool -> EditorIter editor -> IDEM (EditorIter editor, EditorIter editor)) -- ^ identifiermapper (bools=control,shift)- -> (Bool -> Bool -> String -> IDEM ()) -- ^ click handler+ -> (Bool -> Bool -> Text -> IDEM ()) -- ^ click handler -> IDEM [Connection] createHyperLinkSupport sv sw identifierMapper clickHandler = do tv <- getEditorWidget sv@@ -91,7 +94,7 @@ removeTagByName tvb "link" offs <- getLineOffset beg offsc <- getLineOffset iter- if (length slice > 1) then do+ if (T.length slice > 1) then do if (click) then do liftIO $ pointerUngrab eventTime clickHandler ctrlPressed shiftPressed slice
src/IDE/TextEditor/Class.hs view
@@ -28,6 +28,7 @@ import Control.Monad.Reader.Class (MonadReader(..)) import Control.Monad.IO.Class (MonadIO(..)) import System.Glib.Signals (on)+import Data.Text (Text) class TextEditor editor where data EditorBuffer editor@@ -37,9 +38,9 @@ data EditorTagTable editor data EditorTag editor - newBuffer :: Maybe FilePath -> String -> IDEM (EditorBuffer editor)+ newBuffer :: Maybe FilePath -> Text -> IDEM (EditorBuffer editor) applyTagByName :: EditorBuffer editor- -> String+ -> Text -> EditorIter editor -> EditorIter editor -> IDEM ()@@ -71,17 +72,17 @@ -> EditorIter editor -> EditorIter editor -> Bool- -> IDEM String+ -> IDEM Text getStartIter :: EditorBuffer editor -> IDEM (EditorIter editor) getTagTable :: EditorBuffer editor -> IDEM (EditorTagTable editor) getText :: EditorBuffer editor -> EditorIter editor -> EditorIter editor -> Bool- -> IDEM String+ -> IDEM Text hasSelection :: EditorBuffer editor -> IDEM Bool- insert :: EditorBuffer editor -> EditorIter editor -> String -> IDEM ()- newView :: EditorBuffer editor -> Maybe String -> IDEM (EditorView editor)+ insert :: EditorBuffer editor -> EditorIter editor -> Text -> IDEM ()+ newView :: EditorBuffer editor -> Maybe Text -> IDEM (EditorView editor) pasteClipboard :: EditorBuffer editor -> Clipboard -> EditorIter editor@@ -90,12 +91,12 @@ placeCursor :: EditorBuffer editor -> EditorIter editor -> IDEM () redo :: EditorBuffer editor -> IDEM () removeTagByName :: EditorBuffer editor- -> String+ -> Text -> IDEM () selectRange :: EditorBuffer editor -> EditorIter editor -> EditorIter editor -> IDEM () setModified :: EditorBuffer editor -> Bool -> IDEM ()- setStyle :: Bool -> EditorBuffer editor -> Maybe String -> IDEM ()- setText :: EditorBuffer editor -> String -> IDEM ()+ setStyle :: Bool -> EditorBuffer editor -> Maybe Text -> IDEM ()+ setText :: EditorBuffer editor -> Text -> IDEM () undo :: EditorBuffer editor -> IDEM () -- Events@@ -122,7 +123,7 @@ -> Double -> Maybe (Double, Double) -> IDEM ()- setFont :: EditorView editor -> Maybe String -> IDEM ()+ setFont :: EditorView editor -> Maybe Text -> IDEM () setIndentWidth :: EditorView editor -> Int -> IDEM () setWrapMode :: EditorView editor -> Bool -> IDEM () setRightMargin :: EditorView editor -> Maybe Int -> IDEM ()@@ -172,7 +173,7 @@ -> Maybe (EditorIter editor) -> IDEM (Maybe (EditorIter editor)) forwardSearch :: EditorIter editor- -> String+ -> Text -> [TextSearchFlags] -> Maybe (EditorIter editor) -> IDEM (Maybe (EditorIter editor, EditorIter editor))@@ -195,8 +196,8 @@ atStart :: EditorIter editor -> IDEM (EditorIter editor) -- Tag Table- newTag :: EditorTagTable editor -> String -> IDEM (EditorTag editor)- lookupTag :: EditorTagTable editor -> String -> IDEM (Maybe (EditorTag editor))+ newTag :: EditorTagTable editor -> Text -> IDEM (EditorTag editor)+ lookupTag :: EditorTagTable editor -> Text -> IDEM (Maybe (EditorTag editor)) -- Tag background :: EditorTag editor -> Color -> IDEM ()
src/IDE/TextEditor/CodeMirror.hs view
@@ -1,8 +1,10 @@+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- -- Module : IDE.TextEditor.CodeMirror@@ -35,6 +37,21 @@ import Data.Typeable (Typeable) import Graphics.UI.Gtk (scrolledWindowSetShadowType) import Graphics.UI.Gtk.General.Enums (ShadowType(..))+import Data.Text (Text)+import Text.Show (Show)+import Data.Tuple (snd, fst)+import Data.Function (($), (.))+import Data.Maybe (Maybe, Maybe(..))+import GHC.Base (Functor(..), Monad(..))+import Data.Int (Int)+import System.IO (FilePath)+import Data.List ((++))+import Data.Bool (Bool(..), not)+import GHC.Real (fromIntegral, RealFrac(..))+import GHC.Num (Num(..))+import Data.Eq (Eq(..))+import GHC.Float (Double)+import qualified Data.Text as T (pack) #ifdef LEKSAH_WITH_CODE_MIRROR import Control.Monad (unless)@@ -60,7 +77,7 @@ import System.Glib.Signals (after, on) import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame (webFrameGetGlobalContext)-import Text.Blaze.Html.Renderer.String (renderHtml)+import Text.Blaze.Html.Renderer.Text (renderHtml) import Text.Hamlet (shamlet) import Graphics.UI.Gtk (ScrolledWindow, menuPopup, menuAttachToWidget, menuNew,@@ -120,9 +137,12 @@ Nothing -> do mainIteration loop mvar+ type CodeMirrorRef = (WebView, MVar CodeMirrorState) -body = js "body"+++body = js "body" value = js "value" setSize = js2 "setSize" mode = js "mode"@@ -177,7 +197,7 @@ i ^. ch <# (fromIntegral c :: Double) return $ CMIter cm i -newCMBuffer :: Maybe FilePath -> String -> IDEM (EditorBuffer CodeMirror)+newCMBuffer :: Maybe FilePath -> Text -> IDEM (EditorBuffer CodeMirror) newCMBuffer mbFilename contents = do ideR <- ask liftIO $ do@@ -205,7 +225,7 @@ liftIO $ debugM "leksah" "newCMBuffer loaded" liftIO . putMVar s $ CodeMirrorState{..} - webViewLoadString cmWebView (+ webViewLoadString cmWebView (T.pack $ "<html><head>" ++ "<script src=\"lib/codemirror.js\">" ++ "<link rel=\"stylesheet\" href=\"lib/codemirror.css\">"@@ -214,7 +234,7 @@ ++ "</head>" ++ "<body style=\"margin:0;padding:0 auto;\">" ++ "</body></html>"- ) Nothing Nothing ("file://" ++ dataDir ++ "/codemirror.html")+ ) Nothing (T.pack $ "file://" ++ dataDir ++ "/codemirror.html") debugM "leksah" "newCMBuffer loading" return $ CMBuffer (cmWebView, s) @@ -302,12 +322,12 @@ lift $ CMIter cm <$> (m ^. getCursor "head" >>= valToObject) getSlice (CMBuffer cm) (CMIter _ first) (CMIter _ last) includeHidenChars = runCM cm $ do m <- codeMirror- lift $ unpack <$> (m ^. getRange first last >>= valToText)+ lift $ m ^. getRange first last >>= valToText getStartIter (CMBuffer cm) = runCM cm $ cmIter cm 0 0 getTagTable (CMBuffer cm) = return $ CMTagTable cm getText (CMBuffer cm) (CMIter _ first) (CMIter _ last) includeHidenChars = runCM cm $ do m <- codeMirror- lift $ unpack <$> (m ^. getRange first last >>= valToText)+ lift $ m ^. getRange first last >>= valToText hasSelection (CMBuffer cm) = runCM cm $ do m <- codeMirror lift $ (m ^. somethingSelected) >>= valToBool
src/IDE/TextEditor/GtkSourceView.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.TextEditor.GtkSourceView@@ -117,6 +118,9 @@ import System.Glib.Attributes (get, AttrOp(..), set) import qualified Graphics.UI.Gtk as Gtk (endUserAction) import IDE.Utils.GUIUtils (fontDescription)+import Data.Text (Text)+import qualified Data.Text as T (all, length, pack)+import Data.Monoid ((<>)) transformGtkIter :: EditorIter GtkSourceView -> (TextIter -> IO a) -> IDEM (EditorIter GtkSourceView) transformGtkIter (GtkIter i) f = do@@ -134,7 +138,7 @@ data GtkSourceView = GtkSourceView deriving( Typeable, Show ) -newGtkBuffer :: Maybe FilePath -> String -> IDEM (EditorBuffer GtkSourceView)+newGtkBuffer :: Maybe FilePath -> Text -> IDEM (EditorBuffer GtkSourceView) newGtkBuffer mbFilename contents = liftIO $ do lm <- sourceLanguageManagerNew dataDir <- getDataDir@@ -142,14 +146,14 @@ sourceLanguageManagerSetSearchPath lm (Just $ (dataDir </> "language-specs") : oldPath) mbLang <- case mbFilename of Just filename -> do- guess <- contentTypeGuess filename contents (length contents)+ guess <- contentTypeGuess filename contents (T.length contents) sourceLanguageManagerGuessLanguage lm (Just filename) $ case guess of (True, _) -> Just "text/x-haskell" (False, t) -> Just t- Nothing -> sourceLanguageManagerGuessLanguage lm Nothing (Just "text/x-haskell")+ Nothing -> sourceLanguageManagerGuessLanguage lm Nothing (Just ("text/x-haskell" :: Text)) mbLang2 <- case mbLang of- Nothing -> sourceLanguageManagerGuessLanguage lm Nothing (Just "text/x-haskell")+ Nothing -> sourceLanguageManagerGuessLanguage lm Nothing (Just ("text/x-haskell" :: Text)) _ -> return mbLang buffer <- case mbLang2 of Just sLang -> sourceBufferNewWithLanguage sLang@@ -241,7 +245,7 @@ dataDir <- getDataDir sourceStyleSchemeManagerAppendSearchPath styleManager $ dataDir </> "data/styles" ids <- sourceStyleSchemeManagerGetSchemeIds styleManager- let preferedNames = if preferDark then [str++"-dark", str] else [str]+ let preferedNames = if preferDark then [str<>"-dark", str] else [str] forM_ (take 1 $ filter (flip elem ids) preferedNames) $ \ name -> do scheme <- sourceStyleSchemeManagerGetScheme styleManager name sourceBufferSetStyleScheme sb (Just scheme)@@ -335,7 +339,7 @@ let isIdent a = isAlphaNum a || a == '\'' || a == '_' || a == '.' let isOp a = isSymbol a || a == ':' || a == '\\' || a == '*' || a == '/' || a == '-' || a == '!' || a == '@' || a == '%' || a == '&' || a == '?'- if (all isIdent text) || (all isOp text)+ if (T.all isIdent text) || (T.all isOp text) then do hasSel <- textBufferHasSelection sb if not hasSel@@ -441,10 +445,10 @@ lookupTag (GtkTagTable tt) name = liftIO $ fmap GtkTag <$> textTagTableLookup tt name -- Tag- background (GtkTag t) color = liftIO $ set t [textTagBackground := colorHexString color]+ background (GtkTag t) color = liftIO $ set t [textTagBackground := T.pack $ colorHexString color] underline (GtkTag t) value = liftIO $ set t [textTagUnderline := value] -simpleGtkBuffer :: String -> IDEM (EditorBuffer GtkSourceView)+simpleGtkBuffer :: Text -> IDEM (EditorBuffer GtkSourceView) simpleGtkBuffer contents = liftIO $ GtkBuffer <$> do buffer <- sourceBufferNew Nothing textBufferSetText buffer contents
src/IDE/TextEditor/Yi.hs view
@@ -33,6 +33,8 @@ import Data.Typeable (Typeable) import Graphics.UI.Gtk (castToWidget)+import Data.Text (Text)+import qualified Data.Text as T (pack, unpack) #ifdef LEKSAH_WITH_YI import IDE.TextEditor.Class (TextEditor(..))@@ -48,9 +50,9 @@ readCharB, nextWordB, moveToEol, rightB, rightN, nextPointB, unitWord, atBoundaryB, moveToSol, prevWordB, leftB, readB, doUntilB_, prevPointB, Mode, modifyMode, insertingA, undoB,- markSavedB, setSelectRegionB, redoB, setMarkPointB, insertNAt,+ markSavedB, setSelectRegionB, redoB, markPointA, insertNAt, regionIsEmpty, regionEnd, regionStart, selMark, isUnchangedBuffer,- Point(..), MarkValue(..), lineOf, getMarkPointB, pointOfLineColB,+ Point(..), MarkValue(..), lineOf, pointOfLineColB, askMarks, insMark, sizeB, getRawestSelectRegionB, mkRegion, deleteRegionB, newMarkB, Mark, pointB, moveTo, savingPointB, Point, withGivenBuffer0, liftEditor, BufferM, BufferRef, Mode(..),@@ -86,13 +88,13 @@ data Yi = Yi deriving( Typeable, Show ) #ifdef LEKSAH_WITH_YI-newYiBuffer :: Maybe FilePath -> String -> IDEM (EditorBuffer Yi)+newYiBuffer :: Maybe FilePath -> Text -> IDEM (EditorBuffer Yi) newYiBuffer mbFilename contents = do liftYiControl $ do let (filename, id) = case mbFilename of Just fn -> (fn, Right fn) Nothing -> ("Unknown.hs", Left "*leksah*")- buffer <- Yi.newBuffer id contents+ buffer <- Yi.newBuffer id (T.unpack contents) setBufferMode filename buffer return $ YiBuffer buffer @@ -164,7 +166,7 @@ getEndIter (YiBuffer b) = iterFromYiBuffer b sizeB getInsertMark (YiBuffer b) = YiMark <$> (withYiBuffer b $ insMark <$> askMarks) getIterAtLine (YiBuffer b) line = iterFromYiBuffer b $ pointOfLineColB line 1- getIterAtMark (YiBuffer b) (YiMark m) = iterFromYiBuffer b $ getMarkPointB m+ getIterAtMark (YiBuffer b) (YiMark m) = iterFromYiBuffer b $ (use . markPointA) m getIterAtOffset (YiBuffer b) offset = return $ mkYiIter b $ Point offset getLineCount (YiBuffer b) = withYiBuffer b $ sizeB >>= lineOf getModified (YiBuffer b) = not <$> (withYiBuffer b $ gets isUnchangedBuffer)@@ -175,17 +177,17 @@ mkYiIter b (regionEnd region)) getInsertIter (YiBuffer b) = withYiBuffer b $ do insertMark <- insMark <$> askMarks- mkYiIter b <$> getMarkPointB insertMark- getSlice (YiBuffer b) (YiIter first) (YiIter last) includeHidenChars = liftYiControl $+ mkYiIter b <$> (use . markPointA) insertMark+ getSlice (YiBuffer b) (YiIter first) (YiIter last) includeHidenChars = liftYiControl $ T.pack <$> Yi.getText b first last getStartIter (YiBuffer b) = return $ mkYiIter b $ Point 0 getTagTable (YiBuffer b) = return YiTagTable -- TODO- getText (YiBuffer b) (YiIter first) (YiIter last) includeHidenChars = liftYiControl $+ getText (YiBuffer b) (YiIter first) (YiIter last) includeHidenChars = liftYiControl $ T.pack <$> Yi.getText b first last hasSelection (YiBuffer b) = withYiBuffer b $ do region <- getRawestSelectRegionB return $ not $ regionIsEmpty region- insert (YiBuffer b) (YiIter (Iter _ p)) text = withYiBuffer b $ insertNAt text p+ insert (YiBuffer b) (YiIter (Iter _ p)) text = withYiBuffer b $ insertNAt (T.unpack text) p newView (YiBuffer b) mbFontString = do fd <- fontDescription mbFontString liftYiControl $ fmap YiView $ Yi.newView b fd@@ -199,7 +201,7 @@ now <- liftIO $ getCurrentTime withYiBuffer b $ markSavedB now setStyle preferDark (YiBuffer b) mbStyle = return () -- TODO- setText (YiBuffer b) text = liftYiControl $ Yi.setText b text+ setText (YiBuffer b) text = liftYiControl $ Yi.setText b (T.unpack text) undo (YiBuffer b) = withYiBuffer b undoB bufferToWindowCoords (YiView v) point = return point -- TODO drawTabs (YiView _) = return () -- TODO
src/IDE/Utils/ExternalTool.hs view
@@ -36,11 +36,13 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.Maybe (isNothing) import Control.Applicative ((<$>))+import Data.Text (Text)+import qualified Data.Text as T (unpack, pack, null) runExternalTool' :: MonadIDE m- => String+ => Text -> FilePath- -> [String]+ -> [Text] -> FilePath -> C.Sink ToolOutput IDEM () -> m ()@@ -59,9 +61,9 @@ runExternalTool :: MonadIDE m => m Bool -> (ProcessHandle -> IDEM ())- -> String+ -> Text -> FilePath- -> [String]+ -> [Text] -> FilePath -> C.Sink ToolOutput IDEM () -> m ()@@ -70,7 +72,7 @@ run <- runGuard when run $ do when (saveAllBeforeBuild prefs) (do fileSaveAll belongsToWorkspace; return ())- unless (null description) . void $+ unless (T.null description) . void $ triggerEventIDE (StatusbarChanged [CompartmentState description, CompartmentBuild True]) reifyIDE $ \ideR -> forkIO $ do -- If vado is enabled then look up the mount point and transform@@ -79,8 +81,8 @@ (executable', args') <- case mountPoint of Left mp -> do s <- readSettings- a <- vado mp s dir [] executable args- return ("ssh", a)+ a <- vado mp s dir [] executable (map T.unpack args)+ return ("ssh", map T.pack a) _ -> return (executable, args) -- Run the tool (output, pid) <- runTool executable' args' (Just dir)
src/IDE/Utils/GUIUtils.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Utils.GUIUtils@@ -61,6 +61,9 @@ -- (ResponseId(..)) import Control.Monad.IO.Class (liftIO) import Control.Exception as E+import Data.Text (Text)+import Data.Monoid ((<>))+import qualified Data.Text as T (unpack) #ifdef LOCALIZATION @@ -69,7 +72,7 @@ #endif -chooseDir :: Window -> String -> Maybe FilePath -> IO (Maybe FilePath)+chooseDir :: Window -> Text -> Maybe FilePath -> IO (Maybe FilePath) chooseDir window prompt mbFolder = do dialog <- fileChooserDialogNew (Just $ prompt)@@ -95,7 +98,7 @@ return Nothing _ -> return Nothing -chooseFile :: Window -> String -> Maybe FilePath -> IO (Maybe FilePath)+chooseFile :: Window -> Text -> Maybe FilePath -> IO (Maybe FilePath) chooseFile window prompt mbFolder = do dialog <- fileChooserDialogNew (Just $ prompt)@@ -121,7 +124,7 @@ return Nothing _ -> return Nothing -chooseSaveFile :: Window -> String -> Maybe FilePath -> IO (Maybe FilePath)+chooseSaveFile :: Window -> Text -> Maybe FilePath -> IO (Maybe FilePath) chooseSaveFile window prompt mbFolder = do dialog <- fileChooserDialogNew (Just $ prompt)@@ -145,24 +148,24 @@ -openBrowser :: String -> IDEAction+openBrowser :: Text -> IDEAction openBrowser url = do prefs' <- readIDE prefs liftIO (E.catch (do- runProcess (browser prefs') [url] Nothing Nothing Nothing Nothing Nothing+ runProcess (T.unpack $ browser prefs') [T.unpack url] Nothing Nothing Nothing Nothing Nothing return ())- (\ (_ :: SomeException) -> sysMessage Normal ("Can't find browser executable " ++ browser prefs')))+ (\ (_ :: SomeException) -> sysMessage Normal ("Can't find browser executable " <> browser prefs'))) return () -showDialog :: String -> MessageType -> IO ()+showDialog :: Text -> MessageType -> IO () showDialog msg msgType = do dialog <- messageDialogNew Nothing [] msgType ButtonsOk msg _ <- dialogRun dialog widgetDestroy dialog return () -showErrorDialog :: String -> IO ()+showErrorDialog :: Text -> IO () showErrorDialog msg = showDialog msg MessageError -- get widget elements (menu & toolbar)@@ -202,12 +205,12 @@ ui <- getUIAction "ui/menubar/_Configuration/Forget Session" castToToggleAction liftIO $toggleActionGetActive ui -getMenuItem :: String -> IDEM MenuItem+getMenuItem :: Text -> IDEM MenuItem getMenuItem path = do uiManager' <- getUiManager mbWidget <- liftIO $ uiManagerGetWidget uiManager' path case mbWidget of- Nothing -> throwIDE ("State.hs>>getMenuItem: Can't find ui path " ++ path)+ Nothing -> throwIDE ("State.hs>>getMenuItem: Can't find ui path " <> path) Just widget -> return (castToMenuItem widget) getBackgroundBuildToggled :: PaneMonad alpha => alpha (Bool)@@ -311,25 +314,25 @@ #ifdef LOCALIZATION -- | For i18n using hgettext-__ :: String -> String-__ = unsafePerformIO . getText+__ :: Text -> Text+__ = T.pack . unsafePerformIO . getText . T.unpack #else -- | For i18n support. Not included in this build.-__ :: String -> String+__ :: Text -> Text __ = id #endif -fontDescription :: Maybe String -> IDEM FontDescription+fontDescription :: Maybe Text -> IDEM FontDescription fontDescription mbFontString = liftIO $ do case mbFontString of Just str -> do fontDescriptionFromString str Nothing -> do f <- fontDescriptionNew- fontDescriptionSetFamily f "Monospace"+ fontDescriptionSetFamily f ("Monospace" :: Text) return f
src/IDE/Utils/ServerConnection.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Utils.ServerConnection@@ -31,6 +32,8 @@ import Control.Monad.IO.Class (MonadIO(..)) import System.Log.Logger (getLevel, getRootLogger) import Control.Monad (void)+import qualified Data.Text as T (pack, unpack)+import Data.Monoid ((<>)) doServerCommand :: ServerCommand -> (ServerAnswer -> IDEM alpha) -> IDEAction doServerCommand command cont = do@@ -46,10 +49,10 @@ Nothing -> do prefs' <- readIDE prefs handle <- reifyIDE $ \ideR ->- catch (connectTo (serverIP prefs') (PortNumber(PortNum (fromIntegral $ serverPort prefs'))))+ catch (connectTo (T.unpack $ serverIP prefs') (PortNumber(PortNum (fromIntegral $ serverPort prefs')))) (\(exc :: SomeException) -> do catch (startServer (serverPort prefs'))- (\(exc :: SomeException) -> throwIDE ("Can't start leksah-server" ++ show exc))+ (\(exc :: SomeException) -> throwIDE ("Can't start leksah-server" <> T.pack (show exc))) mbHandle <- waitForServer prefs' 100 case mbHandle of Just handle -> return handle@@ -86,7 +89,7 @@ waitForServer prefs s = do threadDelay 100000 -- 0.1 second catch (do- handle <- liftIO $ connectTo (serverIP prefs) (PortNumber(PortNum (fromIntegral $ serverPort prefs)))+ handle <- liftIO $ connectTo (T.unpack $ serverIP prefs) (PortNumber(PortNum (fromIntegral $ serverPort prefs))) return (Just handle)) (\(exc :: SomeException) -> waitForServer prefs (s-1))
src/IDE/Workspaces.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Workspace@@ -88,12 +89,20 @@ import qualified VCSWrapper.Common as VCS import qualified VCSGui.Common as VCSGUI import qualified IDE.Workspaces.Writer as Writer-import Text.Printf (printf) import System.Log.Logger (debugM) import IDE.Pane.Log (showDefaultLogLaunch', getLog) import IDE.LogRef (logOutputDefault) import Data.Foldable (forM_)+import Data.Text (Text)+import qualified Data.Text as T (unpack, pack)+import Data.Monoid ((<>))+import qualified Text.Printf as S (printf)+import Text.Printf (PrintfType)+import qualified Data.Text.IO as T (writeFile) +printf :: PrintfType r => Text -> r+printf = S.printf . T.unpack+ -- | Constructs a new workspace and makes it the current workspace workspaceNew :: IDEAction workspaceNew = do@@ -110,7 +119,7 @@ dir <- liftIO $ myCanonicalizePath $ dropFileName realPath let cPath = dir </> takeFileName realPath newWorkspace = emptyWorkspace {- wsName = takeBaseName cPath,+ wsName = T.pack $ takeBaseName cPath, wsFile = cPath} liftIO $ writeFields cPath newWorkspace Writer.workspaceDescr workspaceOpenThis False (Just cPath)@@ -142,12 +151,12 @@ defaultExists <- doesFileExist defaultWorkspace md <- messageDialogNew (Just mainWindow) [DialogModal] MessageQuestion ButtonsCancel ( __ "You need to have a workspace open for this to work. "- ++ __ "Choose ~/leksah.lkshw to "- ++ __ (if defaultExists then "open workspace " else "create a workspace ")- ++ defaultWorkspace)+ <> __ "Choose ~/leksah.lkshw to "+ <> __ (if defaultExists then "open workspace " else "create a workspace ")+ <> T.pack defaultWorkspace) dialogAddButton md (__ "_New Workspace") (ResponseUser 1) dialogAddButton md (__ "_Open Workspace") (ResponseUser 2)- dialogAddButton md "~/leksah.lkshw" (ResponseUser 3)+ dialogAddButton md ("~/leksah.lkshw" :: Text) (ResponseUser 3) dialogSetDefaultResponse md (ResponseUser 3) set md [ windowWindowPosition := WinPosCenterOnParent ] resp <- dialogRun md@@ -206,7 +215,7 @@ Writer.setWorkspace (Just workspace {wsFile = filePath}) VCSWS.onWorkspaceOpen workspace) (\ (e :: Exc.SomeException) -> reflectIDE- (ideMessage Normal (printf (__ "Can't load workspace file %s\n%s") filePath (show e))) ideR)+ (ideMessage Normal (T.pack $ printf (__ "Can't load workspace file %s\n%s") filePath (show e))) ideR) -- | Closes a workspace@@ -264,7 +273,7 @@ alreadyExists <- liftIO $ doesFileExist (path </> target) unless alreadyExists $ do template <- liftIO $ getModuleTemplate "main" pd "Main" "" ""- liftIO $ UTF8.writeFile (path </> target) template+ liftIO $ T.writeFile (path </> target) template fileOpenThis (path </> target) _ -> return () Nothing -> ideMessage Normal (__ "No package description")@@ -335,7 +344,7 @@ Writer.writeWorkspace ws {wsPackages = delete pack (wsPackages ws)} return () -workspaceActivatePackage :: IDEPackage -> Maybe String -> WorkspaceAction+workspaceActivatePackage :: IDEPackage -> Maybe Text -> WorkspaceAction workspaceActivatePackage pack exe = do ws <- ask let activePath = takeDirectory $ ipdCabalFile pack@@ -465,7 +474,7 @@ else makePackages settings modifiedPacks (MoComposed steps) (MoComposed (MoConfigure:steps)) MoMetaInfo )- (\(e :: Exc.SomeException) -> sysMessage Normal (show e))+ (\(e :: Exc.SomeException) -> sysMessage Normal (T.pack $ show e)) makePackage :: PackageAction makePackage = do
src/IDE/Workspaces/Writer.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module : IDE.Workspaces.Writer@@ -46,11 +47,13 @@ (Parameter(..), (<<<-), paraName, emptyParams) import qualified Text.PrettyPrint as PP (text) import System.Log.Logger (debugM)+import qualified Data.Text as T (pack)+import Data.Monoid ((<>)) writeWorkspace :: Workspace -> IDEAction writeWorkspace ws = do timeNow <- liftIO getClockTime- let newWs = ws {wsSaveTime = show timeNow,+ let newWs = ws {wsSaveTime = T.pack $ show timeNow, wsVersion = workspaceVersion, wsPackagesFiles = map ipdCabalFile (wsPackages ws)} setWorkspace $ Just newWs@@ -92,13 +95,13 @@ let wsStr = case mbWs of Nothing -> "" Just ws -> wsName ws- let txt = wsStr ++ " "- ++ (case mbPack of+ let txt = wsStr <> " "+ <> (case mbPack of Nothing -> "" Just p -> packageIdentifierToString (ipdPackageId p))- ++ (case mbExe of+ <> (case mbExe of Nothing -> ""- Just exe -> " " ++ exe)+ Just exe -> " " <> exe) triggerEventIDE (StatusbarChanged [CompartmentPackage txt]) triggerEventIDE (WorkspaceChanged True True) triggerEventIDE UpdateWorkspaceInfo
src/IDE/YiConfig.hs view
@@ -22,8 +22,12 @@ import Data.List (reverse, isPrefixOf) import Yi-import Yi.Keymap.Vim+import qualified Yi.Keymap.Vim as V2+import qualified Yi.Keymap.Vim.Common as V2+import qualified Yi.Keymap.Vim.Utils as V2 +import qualified Yi.Mode.Haskell as Haskell+ import qualified Yi.UI.Pango import Yi.UI.Pango.Control @@ -49,94 +53,67 @@ | modeName m == "haskell" = m { modeGetAnnotations = modeGetAnnotations emptyMode } | otherwise = m -defaultYiConfig = defaultConfig- {- -- Use VTY as the default UI.- startFrontEnd = Yi.UI.Pango.start,- defaultKm = mkKeymap extendedVimKeymap,- modeTable = fmap (onMode $ noHaskellAnnots . prefIndent) (modeTable defaultConfig),- configUI = configUI defaultConfig- }+defaultYiConfig = defaultVimConfig {+ modeTable = myModes ++ modeTable defaultVimConfig,+ defaultKm = myKeymapSet,+ configCheckExternalChangesObsessively = False+} -extendedVimKeymap = defKeymap `override` \super self -> super- {- v_top_level =- (deprioritize >> v_top_level super)- -- On 'o' in normal mode I always want to use the indent of the previous line.- -- TODO: If the line where the newline is to be inserted is inside a- -- block comment then the block comment should be "continued"- -- TODO: Ends up I'm trying to replicate vim's "autoindent" feature. This- -- should be made a function in Yi.- <|> (char 'o' ?>> beginIns self $ do- moveToEol- insertB '\n'- indentAsPreviousB- )- -- On HLX (Haskell Language Extension) I want to go into insert mode such- -- that the cursor position is correctly placed to start entering the name- -- of an language extension in a LANGUAGE pragma.- -- A language pragma will take either the form- -- {-# LANGUAGE Foo #-}- -- or- -- >{-# LANGUAGE Foo #-}- -- The form should be chosen based on the current mode.- <|> ( pString "HXL" >> startExtesnionNameInsert self ),- v_ins_char =- (deprioritize >> v_ins_char super)- -- On enter I always want to use the indent of previous line- -- TODO: If the line where the newline is to be inserted is inside a- -- block comment then the block comment should be "continued"- -- TODO: Ends up I'm trying to replicate vim's "autoindent" feature. This- -- should be made a function in Yi.- <|> ( spec KEnter ?>>! do- insertB '\n'- indentAsPreviousB- )- -- I want softtabs to be deleted as if they are tabs. So if the- -- current col is a multiple of 4 and the previous 4 characters- -- are spaces then delete all 4 characters.- -- TODO: Incorporate into Yi itself.- <|> ( spec KBS ?>>! do- c <- curCol- line <- readRegionB =<< regionOfPartB Line Backward- sw <- indentSettingsB >>= return . shiftWidth- let indentStr = replicate sw ' '- toDel = if (c `mod` sw) /= 0- then 1- else if indentStr `isPrefixOf` reverse line- then sw- else 1- adjBlock (-toDel)- replicateM_ toDel $ deleteB Character Backward- )- -- On starting to write a block comment I want the close comment- -- text inserted automatically.- <|> choice- [ pString open_tag >>! do- insertN $ open_tag ++ " \n"- indentAsPreviousB- insertN $ " " ++ close_tag- lineUp- | (open_tag, close_tag) <-- [ ("{-", "-}") -- Haskell block comments- , ("/*", "*/") -- C++ block comments- ]- ]- }+defaultSearchKeymap :: Keymap+defaultSearchKeymap = do+ Event (KASCII c) [] <- anyEvent+ write (isearchAddE [c]) +myKeymapSet :: KeymapSet+myKeymapSet = V2.mkKeymapSet $ V2.defVimConfig `override` \super this ->+ let eval = V2.pureEval this+ in super {+ -- Here we can add custom bindings.+ -- See Yi.Keymap.Vim.Common for datatypes and+ -- Yi.Keymap.Vim.Utils for useful functions like mkStringBindingE -startExtesnionNameInsert :: ModeMap -> I Event Action ()-startExtesnionNameInsert self = beginIns self $ do- p_current <- pointB- m_current <- getMarkB (Just "'")- setMarkPointB m_current p_current- moveTo $ Point 0- insertB '\n'- moveTo $ Point 0- insertN "{-# LANGUAGE "- p <- pointB- insertN " #-}"- moveTo p+ -- In case of conflict, that is if there exist multiple bindings+ -- whose prereq function returns WholeMatch,+ -- the first such binding is used.+ -- So it's important to have custom bindings first.+ V2.vimBindings = myBindings eval ++ V2.vimBindings super+ }++myBindings :: (String -> EditorM ()) -> [V2.VimBinding]+myBindings eval =+ let nmap x y = V2.mkStringBindingE V2.Normal V2.Drop (x, y, id)+ imap x y = V2.VimBindingE (\evs state -> case V2.vsMode state of+ V2.Insert _ ->+ fmap (const (y >> return V2.Continue))+ (evs `V2.matchesString` x)+ _ -> V2.NoMatch)+ in [+ -- Tab traversal+ nmap "<C-h>" previousTabE+ , nmap "<C-l>" nextTabE+ , nmap "<C-l>" nextTabE++ -- Press space to clear incremental search highlight+ , nmap " " (eval ":nohlsearch<CR>")++ -- for times when you don't press shift hard enough+ , nmap ";" (eval ":")++ , nmap "<F3>" (withBuffer0 deleteTrailingSpaceB)+ , nmap "<F4>" (withBuffer0 moveToSol)+ , nmap "<F1>" (withBuffer0 readCurrentWordB >>= printMsg)++ , imap "<Home>" (withBuffer0 moveToSol)+ , imap "<End>" (withBuffer0 moveToEol)+ ]++myModes = [+ AnyMode Haskell.fastMode {+ -- Disable beautification+ modePrettify = const $ return ()+ , modeGetAnnotations = (const . const) []+ }+ ] #else
tests/IDE/TextEditor/Tests.hs view
@@ -131,7 +131,7 @@ allEditors :: (forall editor. TextEditor editor => ( Maybe FilePath- -> String+ -> Text -> IDEM (EditorBuffer editor)) -> IDEM Bool) -> IO Bool@@ -147,9 +147,9 @@ hFlush stdout hFlush stderr debugM "leksah" $ show editor- testIDE $ test (newBuffer :: Maybe FilePath -> String -> IDEM (EditorBuffer editor))+ testIDE $ test (newBuffer :: Maybe FilePath -> Text -> IDEM (EditorBuffer editor)) -prop_test :: String -> Property+prop_test :: Text -> Property prop_test s = monadicIO $ do let input = filter (not . flip elem "\NUL\r") s result <- run $ allEditors (\buf -> do
win32/makeinstaller.sh view
@@ -3,7 +3,7 @@ . scripts/stage.sh || exit export CABAL_USER_BIN=$HOME/AppData/Roaming/cabal/bin-export GHC_USER_PREFIX=$HOME/AppData/Roaming/cabal/i386-windows-ghc-`ghc$GHCVERSION --numeric-version`+export GHC_USER_PREFIX=$HOME/AppData/Roaming/cabal/x86_64-windows-ghc-`ghc$GHCVERSION --numeric-version` export LEKSAH_PREFIX=$GHC_USER_PREFIX export LEKSAH_SERVER_PREFIX=$GHC_USER_PREFIX export HLINT_X_X_X_X=`ghc-pkg$GHCVERSION list |grep '^ *hlint-' | tail -n1 | tr -d ' \n'`@@ -41,76 +41,76 @@ cp -ru "$LEKSAH_PREFIX/$GHCJS_CODEMIRROR_X_X_X_X"/keymap SourceDir/ghcjs-codemirror cp -ru "$LEKSAH_PREFIX/$GHCJS_CODEMIRROR_X_X_X_X"/theme SourceDir/ghcjs-codemirror mkdir -p SourceDir/bin-cp -u "$CABAL_USER_BIN"/leksah.exe SourceDir/bin -cp -u "$CABAL_USER_BIN"/vcswrapper.exe SourceDir/bin -cp -u "$CABAL_USER_BIN"/vcsgui.exe SourceDir/bin -cp -u "$CABAL_USER_BIN"/vcsgui-askpass.exe SourceDir/bin -cp -u "$CABAL_USER_BIN"/leksah-server.exe SourceDir/bin -cp -u "$CABAL_USER_BIN"/leksahecho.exe SourceDir/bin -cp -u "$GTK_PREFIX"/bin/iconv.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/icudata50.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/icui18n50.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/icule50.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/icuuc50.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libatk-1.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libbz2-1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libcairo-2.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libcairo-gobject-2.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libcrypto-10.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libcurl-4.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libenchant.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libexpat-1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libffi-6.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libfontconfig-1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libfreetype-6.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgailutil-3-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgcc_s_sjlj-1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgdk-3-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgdk_pixbuf-2.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgio-2.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libglib-2.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgmodule-2.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgobject-2.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgst*-1.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgthread-2.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgtk-3-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libgtksourceview-3.0-1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libharfbuzz-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libharfbuzz-icu-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libidn-11.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libintl-8.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libjavascriptcoregtk-3.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libjpeg-62.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libpango-1.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libpangocairo-1.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libpangoft2-1.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libpangowin32-1.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libpixman-1-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libpng16-16.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libsoup-2.4-1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libsqlite3-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libssh2-1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libssl-10.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libstdc++-6.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libxml2-2.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libxslt-1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libwebkitgtk-3.0-0.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libwebp-4.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/libwinpthread-1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/zlib1.dll SourceDir/bin -cp -u "$GTK_PREFIX"/bin/pkg-config.exe SourceDir/bin +cp -u "$CABAL_USER_BIN"/leksah.exe SourceDir/bin+cp -u "$CABAL_USER_BIN"/vcswrapper.exe SourceDir/bin+cp -u "$CABAL_USER_BIN"/vcsgui.exe SourceDir/bin+cp -u "$CABAL_USER_BIN"/vcsgui-askpass.exe SourceDir/bin+cp -u "$CABAL_USER_BIN"/leksah-server.exe SourceDir/bin+cp -u "$CABAL_USER_BIN"/leksahecho.exe SourceDir/bin+cp -u "$GTK_PREFIX"/bin/iconv.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/icudata50.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/icui18n50.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/icule50.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/icuuc50.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libatk-1.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libbz2-1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libcairo-2.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libcairo-gobject-2.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libcrypto-10.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libcurl-4.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libenchant.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libexpat-1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libffi-6.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libfontconfig-1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libfreetype-6.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgailutil-3-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgcc_s_sjlj-1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgdk-3-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgdk_pixbuf-2.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgio-2.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libglib-2.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgmodule-2.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgobject-2.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgst*-1.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgthread-2.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgtk-3-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libgtksourceview-3.0-1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libharfbuzz-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libharfbuzz-icu-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libidn-11.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libintl-8.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libjavascriptcoregtk-3.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libjpeg-62.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libpango-1.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libpangocairo-1.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libpangoft2-1.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libpangowin32-1.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libpixman-1-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libpng16-16.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libsoup-2.4-1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libsqlite3-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libssh2-1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libssl-10.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libstdc++-6.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libxml2-2.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libxslt-1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libwebkitgtk-3.0-0.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libwebp-4.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/libwinpthread-1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/zlib1.dll SourceDir/bin+cp -u "$GTK_PREFIX"/bin/pkg-config.exe SourceDir/bin mkdir -p SourceDir/share-cp -ru "$GTK_PREFIX"/share/themes SourceDir/share -cp -ru "$GTK_PREFIX"/share/glib-2.0 SourceDir/share -cp -ru "$GTK_PREFIX"/share/gtksourceview-3.0 SourceDir/share +cp -ru "$GTK_PREFIX"/share/themes SourceDir/share+cp -ru "$GTK_PREFIX"/share/glib-2.0 SourceDir/share+cp -ru "$GTK_PREFIX"/share/gtksourceview-3.0 SourceDir/share mkdir -p SourceDir/libexec-cp -ru "$GTK_PREFIX"/libexec/gstreamer-1.0 SourceDir/libexec +cp -ru "$GTK_PREFIX"/libexec/gstreamer-1.0 SourceDir/libexec -cp -ru "$GTK_PREFIX"/include SourceDir -cp -ru "$GTK_PREFIX"/lib SourceDir +cp -ru "$GTK_PREFIX"/include SourceDir+cp -ru "$GTK_PREFIX"/lib SourceDir # mkdir -p SourceDir/fonts-# cp -ru /c/Windows/Fonts/DejaVuS*.ttf SourceDir +# cp -ru /c/Windows/Fonts/DejaVuS*.ttf SourceDir heat dir SourceDir -srd -gg -sfrag -template fragment -out heat.wxs -cg Leksah -dr INSTALLDIR -sreg suppress registry harvesting || exit candle heat.wxs || exit