diff --git a/WSEdit.hs b/WSEdit.hs index e7b4e3e..33350dd 100644 --- a/WSEdit.hs +++ b/WSEdit.hs @@ -80,7 +80,7 @@ splitArgs args glob loc = fext = case filter (isPrefixOf "-ff") sw of [] | any (isInfixOf "-c") sw -> Just "wsconf" - [] | otherwise -> getExt <$> filename + | otherwise -> getExt <$> filename l -> Just $ drop 3 $ lastNote (fqn "splitArgs") l @@ -107,18 +107,19 @@ start = do -- Read the global and local config files. Use an empty string in case of -- nonexistence. - h <- liftIO $ getHomeDirectory + h <- liftIO getHomeDirectory b <- doesDirectoryExist $ h ++ "/.config/wsedit" mods <- if b - then listDirectory (h ++ "/.config/wsedit") - >>= mapM ( fmap (lines . fromMaybe "") - . mayReadFile - . ((h ++ "/.config/wsedit/") ++ ) - ) - . filter (isSuffixOf ".wsconf") - >>= return . concat + then fmap concat + ( mapM ( fmap (lines . fromMaybe "") + . mayReadFile + . ((h ++ "/.config/wsedit/") ++ ) + ) + . filter (isSuffixOf ".wsconf") + =<< listDirectory (h ++ "/.config/wsedit") + ) else return [""] @@ -224,10 +225,7 @@ filterFileArgs (Just ext) s = in concatMap words $ gl - ++ ( filter (/= "") - $ map (fromMaybe "" . stripPrefix (ext ++ ":")) - loc - ) + ++ filter (/= "") (map (fromMaybe "" . stripPrefix (ext ++ ":")) loc) @@ -311,20 +309,32 @@ mainLoop = do -- if not found: insert the pressed key -- if it's not alphanumeric: show an "event not bound" warning catchEditor - ( fromMaybe (case ev of - EvKey (KChar k) [] -> deleteSelection - >> insert k - >> listAutocomplete - - EvResize _ _ -> return () - _ -> setStatus $ "Event not bound: " - ++ show ev - ) - $ fmap fst + ( maybe (case ev of + EvKey (KChar k) [] -> deleteSelection + >> insert k + >> listAutocomplete + + EvResize _ _ -> return () + _ -> setStatus $ "Event not bound: " + ++ show ev + ) + fst $ lookup ev $ catMaybes $ keymap c - ) $ \e -> do + ) errHdl + + + when (dumpEvents c) $ do + s <- get + setStatus $ show ev ++ status s + + b <- continue <$> get + when b mainLoop + + where + errHdl :: SomeException -> WSEdit () + errHdl e = do b <- changed <$> get if b then do @@ -336,11 +346,3 @@ mainLoop = do ++ " ./CRASH-RESCUE ." else bail $ "An error occured: " ++ show e - - - when (dumpEvents c) $ do - s <- get - setStatus $ show ev ++ status s - - b <- continue <$> get - when b mainLoop diff --git a/WSEdit/Buffer.hs b/WSEdit/Buffer.hs index 50db1a5..4b55861 100644 --- a/WSEdit/Buffer.hs +++ b/WSEdit/Buffer.hs @@ -104,19 +104,19 @@ length b = prefLen b + sufLen b + 1 -- | Retrieve a sublist from the buffer. Indices are absolute and zero-based. sub :: Int -> Int -> Buffer a -> [a] -sub from to b = ( L.reverse - $ L.drop (prefLen b - to - 1) - $ L.take (prefLen b - from) - $ prefix b - ) - ++ (if from <= currPos b && currPos b <= to - then [curr b] - else [] - ) - ++ ( L.drop (from - prefLen b - 1) - $ L.take (to - prefLen b) - $ suffix b - ) +sub from to b = L.reverse + ( L.drop (prefLen b - to - 1) + $ L.take (prefLen b - from) + $ prefix b + ) + ++ (if from <= currPos b && currPos b <= to + then [curr b] + else [] + ) + ++ L.drop (from - prefLen b - 1) + ( L.take (to - prefLen b) + $ suffix b + ) -- | Retrieve the element left of the current position. @@ -327,8 +327,8 @@ withLeftDef d f b | L.null $ prefix b = b { prefix = [f d] withNLeft :: Int -> (a -> a) -> Buffer a -> Buffer a withNLeft n f b = let - l = (P.map f $ take n $ prefix b) - ++ ( drop n $ prefix b) + l = P.map f (take n $ prefix b) + ++ drop n ( prefix b) in b { prefix = l , prefLen = P.length l @@ -370,8 +370,8 @@ withRightDef d f b | L.null $ suffix b = b { suffix = [f d] withNRight :: Int -> (a -> a) -> Buffer a -> Buffer a withNRight n f b = let - l = (P.map f $ take n $ suffix b) - ++ ( drop n $ suffix b) + l = P.map f (take n $ suffix b) + ++ drop n ( suffix b) in b { suffix = l , sufLen = P.length l diff --git a/WSEdit/Control/Autocomplete.hs b/WSEdit/Control/Autocomplete.hs index 31f06ac..4c4fe8a 100644 --- a/WSEdit/Control/Autocomplete.hs +++ b/WSEdit/Control/Autocomplete.hs @@ -12,7 +12,6 @@ import Control.Monad (forM_, unless, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.RWS.Strict (ask, get, modify, put) import Data.Char (isSpace) -import Data.Maybe (fromMaybe) import Data.List (intercalate, isSuffixOf, stripPrefix) import System.Directory ( doesDirectoryExist, doesFileExist , getCurrentDirectory, listDirectory @@ -46,10 +45,10 @@ dictAdd f = do let depths = map snd - $ filter (\(x, _) -> fromMaybe (f == fname s) $ fmap (`isSuffixOf` f) x) + $ filter (\(x, _) -> maybe (f == fname s) (`isSuffixOf` f) x) $ buildDict s - when (not $ null depths) $ do + unless (null depths) $ do txt <- liftIO $ readFile f d <- liftIO @@ -133,7 +132,7 @@ listAutocomplete :: WSEdit () listAutocomplete = do s <- get - unless ((null $ buildDict s) || (readOnly s)) + unless (null (buildDict s) || readOnly s) $ case getKeywordAtCursor (cursorPos s) $ snd $ B.curr diff --git a/WSEdit/Control/Base.hs b/WSEdit/Control/Base.hs index 7e149c0..f376e0d 100644 --- a/WSEdit/Control/Base.hs +++ b/WSEdit/Control/Base.hs @@ -61,7 +61,7 @@ alterState a = modify (\s -> s { canComplete = False }) -- | Moves the viewport by the given amount of rows, columns. moveViewport :: Int -> Int -> WSEdit () -moveViewport r c = do +moveViewport r c = getOffset >>= setOffset . withPair @@ -107,14 +107,12 @@ moveCursor r c = alterState $ do -- Targeted visual cursor offset tPos <- case wantsPos s of + Just p -> return p Nothing -> do unless (n == 0) $ modify (\s' -> s' { wantsPos = Just vPos }) return vPos - Just p -> do - return p - -- Resulting textual cursor offset (amount of characters) newC <- visToTxtPos targetLn tPos setCursor (tLnNo, newC) diff --git a/WSEdit/Control/Global.hs b/WSEdit/Control/Global.hs index 0c0c27d..132d2d3 100644 --- a/WSEdit/Control/Global.hs +++ b/WSEdit/Control/Global.hs @@ -237,10 +237,7 @@ load = alterState $ do { edLines = B.toFirst l , fname = p' , cursorPos = 1 - , readOnly = if w - then readOnly s - else True - + , readOnly = not w || readOnly s , replaceTabs = if detectTabs s then '\t' `notElem` txt else replaceTabs s diff --git a/WSEdit/Control/Selection.hs b/WSEdit/Control/Selection.hs index efb8baf..de4c0ab 100644 --- a/WSEdit/Control/Selection.hs +++ b/WSEdit/Control/Selection.hs @@ -169,8 +169,8 @@ paste = alterBuffer $ do -- | Indent the currently selected area using the current tab width and -- replacement settings. indentSelection :: WSEdit () -indentSelection = alterBuffer $ do - getMark >>= \case +indentSelection = alterBuffer + $ getMark >>= \case Nothing -> return () Just (sR, _) -> do s <- get @@ -201,8 +201,8 @@ indentSelection = alterBuffer $ do -- | Unindent the currently selected area using the current tab width and -- replacement settings. unindentSelection :: WSEdit () -unindentSelection = alterBuffer $ do - getMark >>= \case +unindentSelection = alterBuffer + $ getMark >>= \case Nothing -> return () Just (sR, _) -> do s <- get diff --git a/WSEdit/Control/Text.hs b/WSEdit/Control/Text.hs index cd33cc0..7e8fbd2 100644 --- a/WSEdit/Control/Text.hs +++ b/WSEdit/Control/Text.hs @@ -232,7 +232,7 @@ dumbNewLine = alterBuffer $ do -- | Removes all trailing whitespace in the text buffer. cleanse :: WSEdit () cleanse = alterBuffer $ do - modify (\s -> s { edLines = B.map (withSnd $ trim) $ edLines s }) + modify (\s -> s { edLines = B.map (withSnd trim) $ edLines s }) moveCursor 0 0 where diff --git a/WSEdit/Data.hs b/WSEdit/Data.hs index 2d11466..6fb0f1d 100644 --- a/WSEdit/Data.hs +++ b/WSEdit/Data.hs @@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleInstances , LambdaCase - , StandaloneDeriving , TypeSynonymInstances #-} @@ -79,7 +78,7 @@ fqn = ("WSEdit.Data." ++) -- | Version number constant. version :: String -version = "1.0.0.3 RC" +version = "1.0.0.4 RC" -- | Upstream URL. upstream :: String @@ -238,12 +237,12 @@ clearMark = do -- | Retrieve the position of the first selected element. getFirstSelected :: WSEdit (Maybe (Int, Int)) -getFirstSelected = (fmap fst) <$> getSelBounds +getFirstSelected = fmap fst <$> getSelBounds -- | Retrieve the position of the last selected element. getLastSelected :: WSEdit (Maybe (Int, Int)) -getLastSelected = (fmap snd) <$> getSelBounds +getLastSelected = fmap snd <$> getSelBounds -- | Faster combination of 'getFirstSelected' and 'getLastSelected'. @@ -415,9 +414,7 @@ delSelection = getSelBounds >>= \case -- | Retrieve the number of rows, colums displayed by vty, including all borders -- , frames and similar woo. getDisplayBounds :: WSEdit (Int, Int) -getDisplayBounds = ask - >>= displayBounds . outputIface . vtyObj - >>= return . swap +getDisplayBounds = fmap swap (displayBounds . outputIface . vtyObj =<< ask) diff --git a/WSEdit/Help.hs b/WSEdit/Help.hs index c8bdde0..edfde1f 100644 --- a/WSEdit/Help.hs +++ b/WSEdit/Help.hs @@ -90,12 +90,12 @@ keymapHelp km = ) in "Dumping keymap (Meta = Alt on most systems):\n\n" - ++ ( renderText 80 - $ map (uncurry (++)) + ++ renderText 80 + ( map (uncurry (++)) $ concatMap (\case Nothing -> [("",""), ("","")] Just (e, s) -> - zip ( (padRight wdt ' ' (showEv e)) + zip ( padRight wdt ' ' (showEv e) : repeat (replicate wdt ' ') ) $ chunkWords (80 - wdt) s ) @@ -134,7 +134,7 @@ keymapHelp km = -- margin (87) | confHelp :: String -confHelp = renderText 80 $ +confHelp = renderText 80 [ "Persistent Configuration" , "" , "There are four distinct locations from which you can influence the behaviour of" @@ -169,7 +169,7 @@ confHelp = renderText 80 $ -- margin (87) | usageHelp :: String -usageHelp = renderText 80 $ +usageHelp = renderText 80 [ "Usage: wsedit [-s] [] [filename [line no. [column no.]]]" , "" , "" @@ -358,7 +358,7 @@ usageHelp = renderText 80 $ -- margin (87) | versionHelp :: String -versionHelp = renderText 80 $ +versionHelp = renderText 80 [ "Wyvernscale Source Code Editor (wsedit) Version " ++ version , "" , "Licensed under the Wyvernscale Source Code License Version " ++ licenseVersion diff --git a/WSEdit/Output.hs b/WSEdit/Output.hs index 2bf5119..f73c6c3 100644 --- a/WSEdit/Output.hs +++ b/WSEdit/Output.hs @@ -150,7 +150,7 @@ lineRep lNo str = do -- Initial list of comment starting points comL :: [Int] comL = map (+1) - $ concatMap (flip findInStr str) + $ concatMap (`findInStr` str) $ lineComment conf -- List of string bounds @@ -175,7 +175,7 @@ lineRep lNo str = do -- List of comment starting points, minus those that are inside a string comL' :: [Int] - comL' = filter (\c -> not $ any (\r -> inRange r c) strL) comL + comL' = filter (\c -> not $ any (`inRange` c) strL) comL -- First comment starting point in the line comAt :: Maybe Int @@ -191,11 +191,11 @@ lineRep lNo str = do (case maySel of Just (sS, sE) | sS <= (lNo, tPos) && (lNo, tPos) <= sE -> HSelected - _ | any (flip inRange tPos) sL -> HSearch - _ | fromMaybe maxBound comAt <= tPos -> HComment - _ | any (flip inRange tPos) strL -> HString - _ | any (flip inRange tPos) kwL -> HKeyword - _ | otherwise -> HNone + _ | any (`inRange` tPos) sL -> HSearch + | fromMaybe maxBound comAt <= tPos -> HComment + | any (`inRange` tPos) strL -> HString + | any (`inRange` tPos) kwL -> HKeyword + | otherwise -> HNone ) (lNo, tPos) vPos c return (i:im, tPos + 1, vPos + length (snd i)) @@ -233,11 +233,7 @@ visToTxtPos = pos 1 -- | Returns the visual position of the cursor in a line, given its textual one. txtToVisPos :: String -> Int -> WSEdit Int -txtToVisPos txt n = (+1) - <$> ( stringWidth 1 - $ take (n - 1) - txt - ) +txtToVisPos txt n = (+1) <$> stringWidth 1 (take (n - 1) txt) @@ -315,27 +311,26 @@ makeHeader = do (_, txtCols ) <- getViewportDimensions return - $ ( string (dColNoFormat d) - $ (replicate (lNoWidth + 3) ' ') - ++ ( take (txtCols + 1) - $ drop scrollCols - $ (' ':) - $ concat - $ map ( padRight (dColNoInterval d) ' ' - . show - ) - [1, dColNoInterval d + 1 ..] - ) - ) + $ string (dColNoFormat d) + ( replicate (lNoWidth + 3) ' ' + ++ take (txtCols + 1) + ( drop scrollCols + $ (' ':) + $ concatMap ( padRight (dColNoInterval d) ' ' + . show + ) + [1, dColNoInterval d + 1 ..] + ) + ) <-> string (dFrameFormat d) ( replicate (lNoWidth + 2) ' ' ++ "+" - ++ ( take (txtCols + 1) - $ drop scrollCols - $ ('-':) - $ cycle - $ 'v' : replicate (dColNoInterval d - 1) '-' - ) + ++ take (txtCols + 1) + ( drop scrollCols + $ ('-':) + $ cycle + $ 'v' : replicate (dColNoInterval d - 1) '-' + ) ++ "+-" ) @@ -353,25 +348,26 @@ makeLineNos = do (txtRows , _)<- getViewportDimensions return $ vertCat - $ map (\n -> char (dLineNoFormat d) ' ' - <|> ( string (if r == n && not (readOnly s) - then dCurrLnMod d $ dLineNoFormat d - else if n `mod` dLineNoInterv d == 0 - then dLineNoFormat d - else dFrameFormat d - ) - $ padLeft lNoWidth ' ' - $ if n <= B.length (edLines s) - then if n `mod` dLineNoInterv d == 0 - || r == n - then show n - else "·" - else "" - ) - <|> string (dFrameFormat d) " |" - ) + $ map (mkLn s d lNoWidth r) [scrollRows + 1, scrollRows + 2 .. scrollRows + txtRows] + where + mkLn :: EdState -> EdDesign -> Int -> Int -> Int -> Image + mkLn s d lNoWidth r n = + char (dLineNoFormat d) ' ' + <|> string (case () of + _ | r == n && not (readOnly s) -> dCurrLnMod d $ dLineNoFormat d + | n `mod` dLineNoInterv d == 0 -> dLineNoFormat d + | otherwise -> dFrameFormat d + ) + ( padLeft lNoWidth ' ' + $ case () of + _ | n > B.length (edLines s) -> "" + | n `mod` dLineNoInterv d == 0 || r == n -> show n + | otherwise -> "·" + ) + <|> string (dFrameFormat d) " |" + -- | Creates the bottom border of the interface. @@ -582,9 +578,9 @@ makeScrollbar = do repl (d, s, cProg, marksAt) (n, c) = char (dFrameFormat d) '|' <|> case () of _ | readOnly s -> char ( dFrameFormat d) c - _ | n == cProg -> char (dCurrLnMod d $ dLineNoFormat d) '<' - _ | n `elem` marksAt -> char ( dJumpMarkFmt d) '•' - _ | otherwise -> char ( dFrameFormat d) c + | n == cProg -> char (dCurrLnMod d $ dLineNoFormat d) '<' + | n `elem` marksAt -> char ( dJumpMarkFmt d) '•' + | otherwise -> char ( dFrameFormat d) c @@ -605,7 +601,7 @@ draw = do liftIO $ update (vtyObj c) Picture - { picCursor = if (readOnly s || ru + rd + cl + cr > 0) + { picCursor = if readOnly s || ru + rd + cl + cr > 0 then NoCursor else uncurry Cursor $ swap cursor , picLayers = [ frame diff --git a/WSEdit/Util.hs b/WSEdit/Util.hs index fb6c173..39bfee4 100644 --- a/WSEdit/Util.hs +++ b/WSEdit/Util.hs @@ -147,11 +147,11 @@ dump :: (Show a) => String -> a -> a dump s x = x `seq` unsafePerformIO (appendFile "dmp" $ s ++ ":\n" - ++ ( unlines - $ map ("\t"++) - $ lines - $ ppShow x - ) + ++ unlines + ( map ("\t"++) + $ lines + $ ppShow x + ) ++ "\n\n" ) `seq` x @@ -325,8 +325,8 @@ findInStr :: (Eq a) => [a] -> [a] -> [Int] findInStr [] _ = error "findInStr: empty pattern" findInStr _ [] = [] findInStr pat str@(_:xs) - | match pat str = 0 : (map (+1) $ findInStr pat xs) - | otherwise = (map (+1) $ findInStr pat xs) + | match pat str = 0 : map (+1) (findInStr pat xs) + | otherwise = map (+1) (findInStr pat xs) where match :: (Eq a) => [a] -> [a] -> Bool @@ -349,9 +349,9 @@ findIsolated pa str findIs [] _ = error "findIsolated: empty pattern" findIs _ [] = [] findIs pat (x:xs) - | isIdentifierChar x = map (+1) $ findIs pat xs - | match pat xs = 1 : (map (+1) $ findIs pat xs) - | otherwise = map (+1) $ findIs pat xs + | isIdentifierChar x = map (+1) $ findIs pat xs + | match pat xs = 1 : map (+1) ( findIs pat xs) + | otherwise = map (+1) $ findIs pat xs match :: String -> String -> Bool match (p:ps) (y:ys) | p == y = match ps ys @@ -373,14 +373,13 @@ findDelimBy mC delim (x: xs) = Nothing -> map (withPair (+1) (+1)) $ findDelimBy mC delim xs Just c -> case find mC c xs of - Nothing -> (0, 0) : ( map (withPair (+1) (+1)) - $ findDelimBy mC delim xs - ) - - Just p -> (0, p+1) : ( map (withPair (+(p+2)) (+(p+2))) - $ findDelimBy mC delim - $ drop (p + 1) xs - ) + Nothing -> (0, 0) : map (withPair (+1) (+1)) + (findDelimBy mC delim xs) + + Just p -> (0, p+1) : map (withPair (+(p+2)) (+(p+2))) + ( findDelimBy mC delim + $ drop (p + 1) xs + ) where find :: Maybe Char -> Char -> String -> Maybe Int find _ _ [] = Nothing diff --git a/wsedit.cabal b/wsedit.cabal index 61620af..a0b9bd7 100644 --- a/wsedit.cabal +++ b/wsedit.cabal @@ -1,5 +1,5 @@ name: wsedit -version: 1.0.0.3 +version: 1.0.0.4 synopsis: A simple terminal source code editor. description: homepage: