diff --git a/color-list.hs b/color-list.hs new file mode 100644 --- /dev/null +++ b/color-list.hs @@ -0,0 +1,176 @@ +import Prelude hiding (tan) +import Data.Colour +import Data.Colour.Names +import Data.Colour.SRGB +import Data.Function +import Data.List +import Data.List.NP +import Data.Char +import System.Environment + +allNamedColours :: (Floating a, Ord a) => [(String,Colour a)] +allNamedColours = orderByDensity . sortBy (cmpColours `on` snd) $ + [ ("aliceblue", aliceblue) + , ("antiquewhite", antiquewhite) + , ("aqua", aqua) + , ("aquamarine", aquamarine) + , ("azure", azure) + , ("beige", beige) + , ("bisque", bisque) + , ("black", black) + , ("blanchedalmond", blanchedalmond) + , ("blue", blue) + , ("blueviolet", blueviolet) + , ("brown", brown) + , ("burlywood", burlywood) + , ("cadetblue", cadetblue) + , ("chartreuse", chartreuse) + , ("chocolate", chocolate) + , ("coral", coral) + , ("cornflowerblue", cornflowerblue) + , ("cornsilk", cornsilk) + , ("crimson", crimson) + , ("cyan", cyan) + , ("darkblue", darkblue) + , ("darkcyan", darkcyan) + , ("darkgoldenrod", darkgoldenrod) + , ("darkgray", darkgray) + , ("darkgreen", darkgreen) + , ("darkgrey", darkgrey) + , ("darkkhaki", darkkhaki) + , ("darkmagenta", darkmagenta) + , ("darkolivegreen", darkolivegreen) + , ("darkorange", darkorange) + , ("darkorchid", darkorchid) + , ("darkred", darkred) + , ("darksalmon", darksalmon) + , ("darkseagreen", darkseagreen) + , ("darkslateblue", darkslateblue) + , ("darkslategray", darkslategray) + , ("darkslategrey", darkslategrey) + , ("darkturquoise", darkturquoise) + , ("darkviolet", darkviolet) + , ("deeppink", deeppink) + , ("deepskyblue", deepskyblue) + , ("dimgray", dimgray) + , ("dimgrey", dimgrey) + , ("dodgerblue", dodgerblue) + , ("firebrick", firebrick) + , ("floralwhite", floralwhite) + , ("forestgreen", forestgreen) + , ("fuchsia", fuchsia) + , ("gainsboro", gainsboro) + , ("ghostwhite", ghostwhite) + , ("gold", gold) + , ("goldenrod", goldenrod) + , ("gray", gray) + , ("grey", grey) + , ("green", green) + , ("greenyellow", greenyellow) + , ("honeydew", honeydew) + , ("hotpink", hotpink) + , ("indianred", indianred) + , ("indigo", indigo) + , ("ivory", ivory) + , ("khaki", khaki) + , ("lavender", lavender) + , ("lavenderblush", lavenderblush) + , ("lawngreen", lawngreen) + , ("lemonchiffon", lemonchiffon) + , ("lightblue", lightblue) + , ("lightcoral", lightcoral) + , ("lightcyan", lightcyan) + , ("lightgoldenrodyellow", lightgoldenrodyellow) + , ("lightgray", lightgray) + , ("lightgreen", lightgreen) + , ("lightgrey", lightgrey) + , ("lightpink", lightpink) + , ("lightsalmon", lightsalmon) + , ("lightseagreen", lightseagreen) + , ("lightskyblue", lightskyblue) + , ("lightslategray", lightslategray) + , ("lightslategrey", lightslategrey) + , ("lightsteelblue", lightsteelblue) + , ("lightyellow", lightyellow) + , ("lime", lime) + , ("limegreen", limegreen) + , ("linen", linen) + , ("magenta", magenta) + , ("maroon", maroon) + , ("mediumaquamarine", mediumaquamarine) + , ("mediumblue", mediumblue) + , ("mediumorchid", mediumorchid) + , ("mediumpurple", mediumpurple) + , ("mediumseagreen", mediumseagreen) + , ("mediumslateblue", mediumslateblue) + , ("mediumspringgreen", mediumspringgreen) + , ("mediumturquoise", mediumturquoise) + , ("mediumvioletred", mediumvioletred) + , ("midnightblue", midnightblue) + , ("mintcream", mintcream) + , ("mistyrose", mistyrose) + , ("moccasin", moccasin) + , ("navajowhite", navajowhite) + , ("navy", navy) + , ("oldlace", oldlace) + , ("olive", olive) + , ("olivedrab", olivedrab) + , ("orange", orange) + , ("orangered", orangered) + , ("orchid", orchid) + , ("palegoldenrod", palegoldenrod) + , ("palegreen", palegreen) + , ("paleturquoise", paleturquoise) + , ("palevioletred", palevioletred) + , ("papayawhip", papayawhip) + , ("peachpuff", peachpuff) + , ("peru", peru) + , ("pink", pink) + , ("plum", plum) + , ("powderblue", powderblue) + , ("purple", purple) + , ("red", red) + , ("rosybrown", rosybrown) + , ("royalblue", royalblue) + , ("saddlebrown", saddlebrown) + , ("salmon", salmon) + , ("sandybrown", sandybrown) + , ("seagreen", seagreen) + , ("seashell", seashell) + , ("sienna", sienna) + , ("silver", silver) + , ("skyblue", skyblue) + , ("slateblue", slateblue) + , ("slategray", slategray) + , ("slategrey", slategrey) + , ("snow", snow) + , ("springgreen", springgreen) + , ("steelblue", steelblue) + , ("tan", tan) + , ("teal", teal) + , ("thistle", thistle) + , ("tomato", tomato) + , ("turquoise", turquoise) + , ("violet", violet) + , ("wheat", wheat) + , ("white", white) + , ("whitesmoke", whitesmoke) + , ("yellow", yellow) + , ("yellowgreen", yellowgreen) + ] + +cmpColours :: (Ord a, Floating a) => Colour a -> Colour a -> Ordering +cmpColours = compare `on` toTuple . toSRGB + where toTuple (RGB x y z) = (x, y, z) + +main :: IO () +main = do args <- getArgs + let count = + case args of + [arg] | all isDigit arg -> Just (read arg) + [] -> Nothing + _ -> error "usage" + mapM_ putStrLn -- print them + . maybe id take count -- keep at most `count' colours + . filter (not.("gray"`isInfixOf`)) -- removing some duplicates + . map fst $ (allNamedColours :: [(String,Colour Double)]) diff --git a/git-prompt.hs b/git-prompt.hs --- a/git-prompt.hs +++ b/git-prompt.hs @@ -1,39 +1,65 @@ +{-# LANGUAGE RecordWildCards #-} import System.Console.ANSI +import System.Environment import System.Exit import HSH import Control.Monad import Control.Applicative import Data.Char import Data.Maybe +import Debug.Trace (trace) +-- TODO: show stash information + -- tell Zsh to not count the contents for the length noLength :: String -> String noLength = ("%{"++) . (++"%}") color :: Color -> String color c - = noLength $ setSGRCode [ SetConsoleIntensity BoldIntensity - , SetColor Foreground Dull c] + = setSGRCode [ SetConsoleIntensity BoldIntensity + , SetColor Foreground Dull c] -- I didn't found how to generate sgr0 from Sys.Console.ANSI sgr0 :: String sgr0 = "\SI" -blue, magenta, green, red, noColor :: String -blue = color Blue -magenta = color Magenta -green = color Green -red = color Red -noColor = noLength $ setSGRCode [] ++ sgr0 +data Colors = Colors + { blue, magenta, green, red, noColor :: String } -statsInfo :: IO String -statsInfo = do +noColors :: Colors +noColors = + Colors{blue = "" + ,magenta = "" + ,green = "" + ,red = "" + ,noColor = "" + } + +mapColors :: (String -> String) -> Colors -> Colors +mapColors f Colors{..} = + Colors{blue = f blue + ,magenta = f magenta + ,green = f green + ,red = f red + ,noColor = f noColor + } + +colors :: Colors +colors = Colors{blue = color Blue + ,magenta = color Magenta + ,green = color Green + ,red = color Red + ,noColor = setSGRCode [] ++ sgr0} + +statsInfo :: Colors -> IO String +statsInfo Colors{..} = do gitstat <- fmap lines . run $ "git status 2> /dev/null" - -|- egrep "(# Untracked|# Changes|# Changed but not updated:|# Your branch)" + -|- egrep "(# Untracked|# Changes|# Changed but not updated:|# Your branch|# and have)" let f msg = listToMaybe . map digits $ egrep msg gitstat - digits = reverse . takeWhile isDigit . dropWhile (not . isDigit) . reverse ahead = f "# Your branch is ahead of " behind = f "# Your branch is behind " + diverged = parseDiverged =<< (fmap words . listToMaybe . egrep "# and have" $ gitstat) return . concat $ [green ,['!' | "# Changes to be committed:" `elem` gitstat] @@ -41,7 +67,12 @@ || "# Changed but not updated:" `elem` gitstat] ,maybe "" ((blue++":"++green++"-")++) behind ,maybe "" ((blue++":"++green++"+")++) ahead + ,maybe "" (\(x,y) -> blue++":"++red++"+"++x++"-"++y) diverged ] + where + digits = reverse . takeWhile isDigit . dropWhile (not . isDigit) . reverse + parseDiverged ["#", "and", "have", x, "and", y, "different", "commit(s)", "each,", "respectively."] = Just (x, y) + parseDiverged _ = trace "git-prompt: git status message seems to have changed" Nothing isBareRepo :: IO Bool isBareRepo = readbool =<< run "git config core.bare" @@ -54,9 +85,15 @@ main :: IO () main = do + args <- getArgs ref <- head . lines <$> run "git symbolic-ref HEAD 2> /dev/null" when (null ref) exitFailure - stats <- catch statsInfo . const $ + let myColors + | "--no-color" `elem` args = noColors + | "--zsh-no-length" `elem` args = mapColors noLength colors + | otherwise = colors + Colors{..} = myColors + stats <- catch (statsInfo myColors) . const $ ((blue++":")++) . cond (green ++ "bare") (red ++ "ERR") <$> isBareRepo putStrLn . concat $ diff --git a/iter-lines.hs b/iter-lines.hs deleted file mode 100644 --- a/iter-lines.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -import Control.Exception -import System.Environment (getArgs) -import System.Exit (ExitCode) -import System.IO -import qualified System.Process as P -import qualified Data.ByteString.Lazy.Char8 as L8 -import qualified Data.ByteString.Lazy as L - -main :: IO () -main = do - cmd:args <- getArgs - mapM_ (processWithStdin (P.proc cmd args) . flip L8.snoc '\n') . L8.lines =<< L.getContents - -processWithStdin :: P.CreateProcess -> L.ByteString -> IO ExitCode -processWithStdin process input = do - (Just stdinHdl, _, _, pHdl) <- - P.createProcess process { P.std_in = P.CreatePipe } - handle (\(_ :: IOException) -> return ()) $ do - L.hPut stdinHdl input - hClose stdinHdl - P.waitForProcess pHdl diff --git a/nptools.cabal b/nptools.cabal --- a/nptools.cabal +++ b/nptools.cabal @@ -1,6 +1,6 @@ Name: nptools Cabal-Version: >=1.4 -Version: 0.3.0 +Version: 0.4.0 License: BSD3 License-File: LICENSE Copyright: (c) Nicolas Pouillard @@ -37,14 +37,9 @@ Build-depends: base>=3&&<5, ansi-terminal, HSH ghc-options: -Wall -Odph -executable iter-lines - main-is: iter-lines.hs - Build-depends: base>=3&&<5, process, bytestring - ghc-options: -Wall -Odph - executable label main-is: label.hs - Build-depends: base>=3&&<5, HSH, split, process + Build-depends: base>=3&&<5, HSH, split, process, bytestring ghc-options: -Wall -Odph executable bufferize @@ -126,4 +121,9 @@ executable starecho main-is: starecho.hs + ghc-options: -Wall -Odph + +executable color-list + main-is: color-list.hs + Build-depends: base>=3&&<5, colour, array ghc-options: -Wall -Odph diff --git a/pad.hs b/pad.hs --- a/pad.hs +++ b/pad.hs @@ -1,6 +1,13 @@ import qualified Data.ByteString as S import System.Environment +import System.Exit +import System.IO +import Data.Char main :: IO () -main = do [i,inp,outp] <- getArgs - s <- S.readFile inp - S.writeFile outp $ S.append s $ S.replicate (read i - S.length s) 0 +main = do args <- getArgs + case args of + [i,inp,outp] | all isDigit i -> do + s <- if inp == "-" then S.getContents else S.readFile inp + S.writeFile outp $ S.append s $ S.replicate (read i - S.length s) 0 + _ -> do hPutStrLn stderr "Usage: pad " + exitFailure diff --git a/show-non-ascii.hs b/show-non-ascii.hs --- a/show-non-ascii.hs +++ b/show-non-ascii.hs @@ -1,6 +1,8 @@ import Data.Char import Data.List import Control.Applicative +import System.IO +import System.Environment bool :: a -> a -> Bool -> a bool t e b = if b then t else e @@ -16,4 +18,6 @@ main :: IO () main = do putStrLn "Reading from stdin" + args <- getArgs + hSetEncoding stdin (if "--utf-8" `elem` args then utf8 else latin1) putStrLn =<< unlines . concatMap analyseLine . zip [1..] . lines <$> getContents diff --git a/x-printable.hs b/x-printable.hs --- a/x-printable.hs +++ b/x-printable.hs @@ -2,6 +2,7 @@ import Numeric import Data.Char import System.Environment +import System.Exit import System.IO main :: IO () @@ -12,7 +13,8 @@ case args of ["encode"] -> interact encode ["decode"] -> interact decode - _ -> error "Usage: x-printable [encode|decode]" + _ -> do hPutStrLn stderr "Usage: x-printable [encode|decode]" + exitFailure encode, decode :: String -> String