Ticket #132: haskeline.diff

File haskeline.diff, 12.0 KB (added by igloo, 4 years ago)

  • System/Console/Haskeline/Backend/DumbTerm.hs 

    Sat Jul 25 22:20:04 BST 2009  Ian Lynagh <igloo@earth.li>
  * Make the code compatible with the stricter labelled-field parsing rules
diff -rN -u old-haskeline/System/Console/Haskeline/Backend/DumbTerm.hs new-haskeline/System/Console/Haskeline/Backend/DumbTerm.hs
    old new  
    8787    if length xs1' > p  || newP >= w 
    8888        then refitLine (xs2,ys2) 
    8989        else do -- we haven't moved outside the margins 
    90             put Window {pos=newP} 
     90            put $ Window {pos=newP} 
    9191            case (xs1',xs2') of 
    9292                ([],[]) | ys1 == ys2    -> return () -- no change 
    9393                (_,[]) | xs1' ++ ys1 == ys2 -> -- moved left 
    … …  
    106106    w <- maxWidth 
    107107    let xs' = dropFrames w xs 
    108108    let p = length xs'     
    109     put Window {pos=p} 
     109    put $ Window {pos=p} 
    110110    let ys' = take (w - p) ys 
    111111    let k = length ys' 
    112112    printText $ cr ++ graphemesToString (xs' ++ ys') 

  • System/Console/Haskeline/Backend/Posix.hsc 

    diff -rN -u old-haskeline/System/Console/Haskeline/Backend/Posix.hsc new-haskeline/System/Console/Haskeline/Backend/Posix.hsc
    old new  
    6060                rows :: CUShort <- (#peek struct winsize,ws_row) ws 
    6161                cols :: CUShort <- (#peek struct winsize,ws_col) ws 
    6262                if ret >= 0 
    63                     then return $ Just Layout {height=fromEnum rows,width=fromEnum cols} 
     63                    then return $ Just $ Layout {height=fromEnum rows,width=fromEnum cols} 
    6464                    else return Nothing 
    6565 
    6666unsafeHandleToFD :: Handle -> IO FD 
    6767unsafeHandleToFD h = 
    68   withHandle_ "unsafeHandleToFd" h $ \Handle__{haDevice=dev} -> do 
     68  withHandle_ "unsafeHandleToFd" h $ \(Handle__{haDevice=dev}) -> do 
    6969  case cast dev of 
    7070    Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation 
    7171                                           "unsafeHandleToFd" (Just h) Nothing) 
    … …  
    8080    return $ Just $ Layout {height=read r,width=read c} 
    8181 
    8282tryGetLayouts :: [IO (Maybe Layout)] -> IO Layout 
    83 tryGetLayouts [] = return Layout {height=24,width=80} 
     83tryGetLayouts [] = return $ Layout {height=24,width=80} 
    8484tryGetLayouts (f:fs) = do 
    8585    ml <- f 
    8686    case ml of 
    … …  
    254254    encoders <- liftM2 Encoders (openEncoder codeset) (openPartialDecoder codeset) 
    255255    case ttyH of 
    256256        Nothing -> return fileRT 
    257         Just h -> return fileRT { 
     257        Just h -> return $ fileRT { 
    258258                    closeTerm = closeTerm fileRT >> hClose h, 
    259259                    -- NOTE: could also alloc Encoders once for each call to wrapRunTerm 
    260260                    termOps = Just $ tOps encoders h 
    … …  
    283283    let encoder str = join $ fmap ($ str) $ openEncoder codeset 
    284284    let decoder str = join $ fmap ($ str) $ openDecoder codeset 
    285285    decoder' <- openPartialDecoder codeset 
    286     return RunTerm {putStrOut = \str -> encoder str >>= putTerm, 
     286    return $ RunTerm {putStrOut = \str -> encoder str >>= putTerm, 
    287287                closeTerm = setLocale oldLocale >> return (), 
    288288                wrapInterrupt = withSigIntHandler, 
    289289                encodeForTerm = encoder, 

  • System/Console/Haskeline/Backend/Terminfo.hs 

    diff -rN -u old-haskeline/System/Console/Haskeline/Backend/Terminfo.hs new-haskeline/System/Console/Haskeline/Backend/Terminfo.hs
    old new  
    4343    bellAudible' <- bell `mplus` return mempty 
    4444    bellVisual' <- visualBell `mplus` return mempty 
    4545    wrapLine' <- getWrapLine nl' (leftA' 1) 
    46     return Actions{leftA = leftA', rightA = rightA',upA = upA', 
     46    return $ Actions{leftA = leftA', rightA = rightA',upA = upA', 
    4747                clearToLineEnd = clearToLineEnd', nl = nl',cr = cr', 
    4848                bellAudible = bellAudible', bellVisual = bellVisual', 
    4949                clearAllA = clearAll', 
    … …  
    141141tinfoLayout term = return $ getCapability term $ do 
    142142                        r <- termColumns 
    143143                        c <- termLines 
    144                         return Layout {height=r,width=c} 
     144                        return $ Layout {height=r,width=c} 
    145145 
    146146terminfoKeys :: Terminal -> [(String,Key)] 
    147147terminfoKeys term = catMaybes $ map getSequence keyCapabilities 
    … …  
    176176    TermPos {termRow=r,termCol=c} <- get 
    177177    if c+n < w   
    178178        then do 
    179                 put TermPos {termRow=r,termCol=c+n} 
     179                put $ TermPos {termRow=r,termCol=c+n} 
    180180                output (right n) 
    181181        else do 
    182182              let m = c+n 
    183183              let linesDown = m `div` w 
    184184              let newCol = m `rem` w 
    185               put TermPos {termRow=r+linesDown, termCol=newCol} 
     185              put $ TermPos {termRow=r+linesDown, termCol=newCol} 
    186186              output $ cr <#> mreplicate linesDown nl <#> right newCol 
    187187                       
    188188changeLeft n = do 
    … …  
    190190    TermPos {termRow=r,termCol=c} <- get 
    191191    if c - n >= 0  
    192192        then do  
    193                 put TermPos {termRow = r,termCol = c-n} 
     193                put $ TermPos {termRow = r,termCol = c-n} 
    194194                output (left n) 
    195195        else do       
    196196                let m = n - c 
    197197                let linesUp = 1 + ((m-1) `div` w) 
    198198                let newCol = (-m) `mod` w -- mod returns positive # 
    199                 put TermPos {termRow = r - linesUp, termCol=newCol} 
     199                put $ TermPos {termRow = r - linesUp, termCol=newCol} 
    200200                output $ cr <#> up linesUp <#> right newCol 
    201201                 
    202202-- TODO: I think if we wrap this all up in one call to output, it'll be faster... 
    … …  
    214214    if length str < roomLeft 
    215215        then do 
    216216                posixEncode (graphemesToString str) >>= output . text 
    217                 put TermPos{termRow=r, termCol=c+length str} 
     217                put $ TermPos{termRow=r, termCol=c+length str} 
    218218                return [] 
    219219        else do 
    220220                let (thisLine,rest) = splitAt roomLeft str 
    221221                bstr <- posixEncode (graphemesToString thisLine) 
    222222                output (text bstr <#> wrapLine) 
    223                 put TermPos {termRow=r+1,termCol=0} 
     223                put $ TermPos {termRow=r+1,termCol=0} 
    224224                return rest 
    225225 
    226226drawLineDiffT :: LineChars -> LineChars -> DrawM () 
    … …  
    236236        changeLeft (length ys2) 
    237237 
    238238linesLeft :: Layout -> TermPos -> Int -> Int 
    239 linesLeft Layout {width=w} TermPos {termCol = c} n 
     239linesLeft (Layout {width=w}) (TermPos {termCol = c}) n 
    240240    | c + n < w = 1 
    241241    | otherwise = 1 + div (c+n) w 
    242242 

  • System/Console/Haskeline/Command/History.hs 

    diff -rN -u old-haskeline/System/Console/Haskeline/Command/History.hs new-haskeline/System/Console/Haskeline/Command/History.hs
    old new  
    1313                    deriving Show 
    1414 
    1515prevHistoryM :: [Grapheme] -> HistLog -> Maybe ([Grapheme],HistLog) 
    16 prevHistoryM _ HistLog {pastHistory = []} = Nothing 
    17 prevHistoryM s HistLog {pastHistory=ls:past, futureHistory=future} 
     16prevHistoryM _ (HistLog {pastHistory = []}) = Nothing 
     17prevHistoryM s (HistLog {pastHistory=ls:past, futureHistory=future}) 
    1818        = Just (ls,  
    1919            HistLog {pastHistory=past, futureHistory= s:future}) 
    2020 
    … …  
    163163        delLastChar s = s {searchTerm = minit (searchTerm s)} 
    164164        minit xs = if null xs then [] else init xs 
    165165        oneMoreChar c = doSearch True . addChar c 
    166         searchMore d s = doSearch False s {direction=d} 
     166        searchMore d s = doSearch False (s {direction=d}) 

  • System/Console/Haskeline/Command/Undo.hs 

    diff -rN -u old-haskeline/System/Console/Haskeline/Command/Undo.hs new-haskeline/System/Console/Haskeline/Command/Undo.hs
    old new  
    2828                _ -> False 
    2929 
    3030undoPast, redoFuture :: Save s => s -> Undo -> (s,Undo) 
    31 undoPast ls u@Undo {pastUndo = []} = (ls,u) 
    32 undoPast ls u@Undo {pastUndo = (pastLS:lss)} 
     31undoPast ls u@(Undo {pastUndo = []}) = (ls,u) 
     32undoPast ls u@(Undo {pastUndo = (pastLS:lss)}) 
    3333        = (restore pastLS, u {pastUndo = lss, futureRedo = save ls : futureRedo u}) 
    3434 
    35 redoFuture ls u@Undo {futureRedo = []} = (ls,u) 
    36 redoFuture ls u@Undo {futureRedo = (futureLS:lss)} 
     35redoFuture ls u@(Undo {futureRedo = []}) = (ls,u) 
     36redoFuture ls u@(Undo {futureRedo = (futureLS:lss)}) 
    3737            = (restore futureLS, u {futureRedo = lss, pastUndo = save ls : pastUndo u}) 
    3838 
    3939 

  • System/Console/Haskeline/IO.hs 

    diff -rN -u old-haskeline/System/Console/Haskeline/IO.hs new-haskeline/System/Console/Haskeline/IO.hs
    old new  
    6161    reqV <- newEmptyMVar 
    6262    finished <- newEmptyMVar 
    6363    tid <- forkIO (runHaskeline settings reqV finished) 
    64     return HD {requestVar = reqV, forkedThread = tid, 
    65                 subthreadFinished = finished} 
     64    return $ HD {requestVar = reqV, forkedThread = tid, 
     65                 subthreadFinished = finished} 
    6666 
    6767runHaskeline :: Settings IO -> MVar (Maybe Request) -> MVar () -> IO () 
    6868runHaskeline settings reqV finished = runInputT settings loop 

  • System/Console/Haskeline/Key.hs 

    diff -rN -u old-haskeline/System/Console/Haskeline/Key.hs new-haskeline/System/Console/Haskeline/Key.hs
    old new  
    4444simpleKey = Key noModifier 
    4545 
    4646metaKey :: Key -> Key 
    47 metaKey (Key m bc) = Key m {hasMeta = True} bc 
     47metaKey (Key m bc) = Key (m {hasMeta = True}) bc 
    4848 
    4949simpleChar, metaChar, ctrlChar :: Char -> Key 
    5050simpleChar = simpleKey . KeyChar 
    … …  
    113113 
    114114canonicalizeKey :: Key -> Key 
    115115canonicalizeKey (Key m (KeyChar c)) 
    116     | hasControl m = Key m {hasControl = False} 
     116    | hasControl m = Key (m {hasControl = False}) 
    117117                        (KeyChar (setControlBits c)) 
    118     | hasShift m = Key m {hasShift = False} (KeyChar (toUpper c)) 
     118    | hasShift m = Key (m {hasShift = False}) (KeyChar (toUpper c)) 
    119119canonicalizeKey k = k 

  • System/Console/Haskeline/Vi.hs 

    diff -rN -u old-haskeline/System/Console/Haskeline/Vi.hs new-haskeline/System/Console/Haskeline/Vi.hs
    old new  
    383383                    } 
    384384 
    385385searchText :: SearchEntry -> [Grapheme] 
    386 searchText SearchEntry {entryState = IMode xs ys} = reverse xs ++ ys 
     386searchText (SearchEntry {entryState = IMode xs ys}) = reverse xs ++ ys 
    387387 
    388388instance LineState SearchEntry where 
    389389    beforeCursor prefix se = beforeCursor (prefix ++ [searchChar se]) 
    … …  
    416416    let toSearch' = if null toSearch 
    417417                        then (lastSearch vstate) 
    418418                        else toSearch 
    419     result <- doSearch False SearchMode { 
     419    result <- doSearch False (SearchMode { 
    420420                                    searchTerm = toSearch', 
    421421                                    foundHistory = save cm, -- TODO: not needed 
    422                                     direction = dir} 
     422                                    direction = dir}) 
    423423    case result of 
    424424        Left e -> effect e >> setState cm 
    425425        Right sm -> do 
    426             put vstate {lastSearch = toSearch'} 
     426            put $ vstate {lastSearch = toSearch'} 
    427427            setState (restore (foundHistory sm)) 

  • configure 

    diff -rN -u old-haskeline/configure new-haskeline/configure
    old new  
    1 #!/bin/sh 
    2 # Dummy file to be run by autoconfUserHooks.