diff --git a/ghc-7.10.3.old/libraries/terminfo/System/Console/Terminfo/Base.hs b/ghc-7.10.3/libraries/terminfo/System/Console/Terminfo/Base.hs index 87ac774..d2b262c 100644 --- a/ghc-7.10.3.old/libraries/terminfo/System/Console/Terminfo/Base.hs +++ b/ghc-7.10.3/libraries/terminfo/System/Console/Terminfo/Base.hs @@ -52,7 +52,7 @@ import Foreign.C import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Marshal -import Foreign.Storable (peek,poke) +import Foreign.Storable (peek) import System.Environment (getEnv) import System.IO.Unsafe (unsafePerformIO) import System.IO @@ -63,8 +63,8 @@ import Data.Typeable data TERMINAL newtype Terminal = Terminal (ForeignPtr TERMINAL) -foreign import ccall "&" cur_term :: Ptr (Ptr TERMINAL) -foreign import ccall set_curterm :: Ptr TERMINAL -> IO (Ptr TERMINAL) +-- Use "unsafe" to make set_curterm faster since it's called quite a bit. +foreign import ccall unsafe set_curterm :: Ptr TERMINAL -> IO (Ptr TERMINAL) foreign import ccall "&" del_curterm :: FunPtr (Ptr TERMINAL -> IO ()) foreign import ccall setupterm :: CString -> CInt -> Ptr CInt -> IO () @@ -73,19 +73,15 @@ foreign import ccall setupterm :: CString -> CInt -> Ptr CInt -> IO () -- -- Throws a 'SetupTermError' if the terminfo database could not be read. setupTerm :: String -> IO Terminal -setupTerm term = bracket (peek cur_term) (poke cur_term) $ \_ -> +setupTerm term = withCString term $ \c_term -> with 0 $ \ret_ptr -> do -- NOTE: I believe that for the way we use terminfo -- (i.e. custom output function) -- this parameter does not affect anything. let stdOutput = 1 - {-- Force ncurses to return a new struct rather than - a copy of the current one (which it would do if the - terminal names are the same). This prevents problems - when calling del_term on a struct shared by more than one - Terminal. --} - poke cur_term nullPtr + -- Save the previous terminal to be restored after calling setupterm. + old_term <- set_curterm nullPtr -- Call setupterm and check the return value. setupterm c_term stdOutput ret_ptr ret <- peek ret_ptr @@ -93,7 +89,7 @@ setupTerm term = bracket (peek cur_term) (poke cur_term) $ \_ -> then throwIO $ SetupTermError $ "Couldn't look up terminfo entry " ++ show term else do - cterm <- peek cur_term + cterm <- set_curterm old_term fmap Terminal $ newForeignPtr del_curterm cterm data SetupTermError = SetupTermError String @@ -120,14 +116,10 @@ setupTermFromEnv = do -- TODO: this isn't really thread-safe... withCurTerm :: Terminal -> IO a -> IO a withCurTerm (Terminal term) f = withForeignPtr term $ \cterm -> do - old_term <- peek cur_term - if old_term /= cterm - then do - _ <- set_curterm cterm - x <- f - _ <- set_curterm old_term - return x - else f + old_term <- set_curterm cterm + x <- f + _ <- set_curterm old_term + return x ---------------------- @@ -198,11 +190,11 @@ instance Functor Capability where fmap f (Capability g) = Capability $ \t -> fmap (fmap f) (g t) instance Applicative Capability where - pure = return + pure = Capability . const . pure . Just (<*>) = ap instance Monad Capability where - return = Capability . const . return . Just + return = pure Capability f >>= g = Capability $ \t -> do mx <- f t case mx of diff --git a/ghc-7.10.3.old/libraries/terminfo/configure b/ghc-7.10.3/libraries/terminfo/configure index be70a46..600e92f 100755 --- a/ghc-7.10.3.old/libraries/terminfo/configure +++ b/ghc-7.10.3/libraries/terminfo/configure @@ -656,7 +656,6 @@ infodir docdir oldincludedir includedir -runstatedir localstatedir sharedstatedir sysconfdir @@ -730,7 +729,6 @@ datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' -runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' @@ -983,15 +981,6 @@ do | -silent | --silent | --silen | --sile | --sil) silent=yes ;; - -runstatedir | --runstatedir | --runstatedi | --runstated \ - | --runstate | --runstat | --runsta | --runst | --runs \ - | --run | --ru | --r) - ac_prev=runstatedir ;; - -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ - | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ - | --run=* | --ru=* | --r=*) - runstatedir=$ac_optarg ;; - -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1129,7 +1118,7 @@ fi for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir runstatedir + libdir localedir mandir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1282,7 +1271,6 @@ Fine tuning of the installation directories: --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] - --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] diff --git a/ghc-7.10.3.old/libraries/terminfo/terminfo.cabal b/ghc-7.10.3/libraries/terminfo/terminfo.cabal index 31d84fa..2dfbee9 100644 --- a/ghc-7.10.3.old/libraries/terminfo/terminfo.cabal +++ b/ghc-7.10.3/libraries/terminfo/terminfo.cabal @@ -1,6 +1,6 @@ Name: terminfo Cabal-Version: >=1.10 -Version: 0.4.0.1 +Version: 0.4.0.2 Category: User Interfaces License: BSD3 License-File: LICENSE @@ -29,7 +29,7 @@ Library other-extensions: CPP, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables if impl(ghc>=7.3) other-extensions: Safe, Trustworthy - build-depends: base >= 4.3 && < 4.9 + build-depends: base >= 4.3 && < 4.10 ghc-options: -Wall exposed-modules: System.Console.Terminfo