haskeline 0.2 → 0.2.1
raw patch · 5 files changed
+66/−31 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- System/Console/Haskeline.hs +1/−1
- System/Console/Haskeline/Backend/Posix.hsc +6/−6
- System/Console/Haskeline/Command/History.hs +49/−22
- System/Console/Haskeline/InputT.hs +8/−0
- haskeline.cabal +2/−2
System/Console/Haskeline.hs view
@@ -211,7 +211,7 @@ else moveToNextLine s printLines ls drawLine prefix t-drawEffect _ _ (RingBell _) = actBell+drawEffect prefix s (RingBell t) = drawLineDiff prefix s t >> actBell drawLine :: (LineState s, Term m) => String -> s -> m () drawLine prefix s = drawLineDiff prefix Cleared s
System/Console/Haskeline/Backend/Posix.hsc view
@@ -52,9 +52,9 @@ getKeySequences :: Maybe Terminal -> IO (TreeMap Char Key) getKeySequences term = do sttys <- sttyKeys- let tinfos = fromMaybe ansiKeys (term >>= terminfoKeys)+ let tinfos = maybe [] terminfoKeys term -- note ++ acts as a union; so the below favors sttys over tinfos- return $ listToTree $ tinfos ++ sttys+ return $ listToTree $ ansiKeys ++ tinfos ++ sttys ansiKeys :: [(String, Key)]@@ -64,11 +64,11 @@ ,("\ESC[B", KeyDown) ,("\b", Backspace)] -terminfoKeys :: Terminal -> Maybe [(String,Key)]-terminfoKeys term = getCapability term $ mapM getSequence keyCapabilities+terminfoKeys :: Terminal -> [(String,Key)]+terminfoKeys term = catMaybes $ map getSequence keyCapabilities where getSequence (cap,x) = do - keys <- cap+ keys <- getCapability term cap return (keys,x) keyCapabilities = [(keyLeft,KeyLeft),@@ -144,7 +144,7 @@ wrapKeypad :: MonadException m => Maybe Terminal -> m a -> m a wrapKeypad Nothing f = f wrapKeypad (Just term) f = (maybeOutput keypadOn >> f) - `finally` maybeOutput keypadOn+ `finally` maybeOutput keypadOff where maybeOutput cap = liftIO $ runTermOutput term $ fromMaybe mempty (getCapability term cap)
System/Console/Haskeline/Command/History.hs view
@@ -66,16 +66,16 @@ historyBack, historyForward :: (FromString s, MonadState HistLog m) => Key -> Command m s s historyBack = simpleCommand $ histUpdate prevHistory-historyForward = simpleCommand $ reverseHist $ histUpdate prevHistory+historyForward = simpleCommand $ reverseHist . histUpdate prevHistory histUpdate :: MonadState HistLog m => (s -> HistLog -> (t,HistLog)) -> s -> m (Effect t) histUpdate f = liftM Change . update . f -reverseHist :: MonadState HistLog m => (a -> m b) -> a -> m b-reverseHist f x = do+reverseHist :: MonadState HistLog m => m b -> m b+reverseHist f = do modify reverser- y <- f x+ y <- f modify reverser return y where@@ -83,29 +83,39 @@ pastHistory=futureHistory h} data SearchMode = SearchMode {searchTerm :: String,- foundHistory :: InsertMode}+ foundHistory :: InsertMode,+ direction :: Direction} deriving Show +data Direction = Forward | Reverse+ deriving (Show,Eq)++directionName :: Direction -> String+directionName Forward = "i-search"+directionName Reverse = "reverse-i-search"+ instance LineState SearchMode where beforeCursor _ sm = beforeCursor prefix (foundHistory sm)- where prefix = "(reverse-i-search)`" ++ searchTerm sm ++ "': "+ where + prefix = "(" ++ directionName (direction sm) ++ ")`" + ++ searchTerm sm ++ "': " afterCursor = afterCursor . foundHistory instance Result SearchMode where toResult = toResult . foundHistory -startSearchMode :: InsertMode -> SearchMode-startSearchMode im = SearchMode {searchTerm = "",foundHistory=im}+startSearchMode :: Direction -> InsertMode -> SearchMode+startSearchMode dir im = SearchMode {searchTerm = "",foundHistory=im, direction=dir} addChar :: Char -> SearchMode -> SearchMode addChar c s = s {searchTerm = searchTerm s ++ [c]} -searchHistories :: String -> [(String,HistLog)] -> Maybe (SearchMode,HistLog)-searchHistories text = foldr mplus Nothing . map findIt+searchHistories :: Direction -> String -> [(String,HistLog)] -> Maybe (SearchMode,HistLog)+searchHistories dir text = foldr mplus Nothing . map findIt where findIt (l,h) = do im <- findInLine text l- return (SearchMode text im,h)+ return (SearchMode text im dir,h) findInLine :: String -> String -> Maybe InsertMode findInLine text l = find' [] l@@ -121,25 +131,42 @@ l = toResult sm in (text,prevHistories l h) +searchBackwards :: Bool -> SearchMode -> HistLog -> Maybe (SearchMode, HistLog)+searchBackwards useCurrent s h = let+ (text,hists) = prepSearch s h+ hists' = if useCurrent then (toResult s,h):hists else hists+ in searchHistories (direction s) text hists'++doSearch :: MonadState HistLog m => Bool -> SearchMode -> m (Effect SearchMode)+doSearch useCurrent sm = case direction sm of+ Reverse -> searchHist+ Forward -> reverseHist searchHist+ where+ searchHist = do+ hist <- get+ case searchBackwards useCurrent sm hist of+ Just (sm',hist') -> put hist' >> return (Change sm')+ Nothing -> return (RingBell sm)+ searchHistory :: MonadState HistLog m => Command m InsertMode InsertMode-searchHistory = controlKey 'r' +> change startSearchMode >|> backSearching+searchHistory = choiceCmd [+ backKey +> change (startSearchMode Reverse)+ , forwardKey +> change (startSearchMode Forward)+ ] >|> keepSearching where backKey = controlKey 'r'- backSearching = choiceCmd [+ forwardKey = controlKey 's'+ keepSearching = choiceCmd [ choiceCmd [ charCommand oneMoreChar- , backKey +> simpleCommand searchBackMore+ , backKey +> simpleCommand (searchMore Reverse)+ , forwardKey +> simpleCommand (searchMore Forward) , Backspace +> change delLastChar , KeyChar '\b' +> change delLastChar- ] >|> backSearching+ ] >|> keepSearching , changeWithoutKey foundHistory -- abort ] delLastChar s = s {searchTerm = minit (searchTerm s)} minit xs = if null xs then "" else init xs- oneMoreChar c = histUpdate (\s h -> let- (text,hists) = prepSearch s h- in fromMaybe (s,h) $ searchHistories text ((toResult s,h):hists)- ) . addChar c- searchBackMore = histUpdate $ \s h -> let- (text,hists) = prepSearch s h- in fromMaybe (s,h) $ searchHistories text hists+ oneMoreChar c = doSearch True . addChar c+ searchMore d s = doSearch False s {direction=d}
System/Console/Haskeline/InputT.hs view
@@ -11,6 +11,8 @@ import System.Directory(getHomeDirectory) import System.FilePath+import Control.Applicative+import Control.Monad(liftM, ap) -- | Application-specific customizations to the user interface. data Settings m = Settings {complete :: CompletionFunc m, -- ^ Custom tab completion@@ -37,6 +39,12 @@ MonadReader Prefs, MonadReader (Settings m), MonadReader (RunTerm (InputCmdT m))) +instance Monad m => Functor (InputT m) where+ fmap = liftM++instance Monad m => Applicative (InputT m) where+ pure = return+ (<*>) = ap instance MonadTrans InputT where lift = InputT . lift . lift . lift . lift
haskeline.cabal view
@@ -1,6 +1,6 @@ Name: haskeline Cabal-Version: >=1.2-Version: 0.2+Version: 0.2.1 Category: User Interfaces License: BSD3 License-File: LICENSE@@ -17,7 +17,7 @@ . Haskeline runs both on POSIX-compatible systems and on Windows (under MinGW).-Homepage: http://code.haskell.org/haskeline+Homepage: http://trac.haskell.org/haskeline Stability: Experimental Build-Type: Simple