nptools 0.2.1 → 0.2.2

raw patch · 10 files changed

+260/−16 lines, 10 filesdep +unixnew-component:exe:getpinnew-component:exe:nestnew-component:exe:starechonew-component:exe:timer

Dependencies added: unix

Files

• bufferize.hs +24/−2
• color-diff.hs +5/−1
• getpin.hs +17/−0
• git-prompt.hs +30/−10
• nest.hs +23/−0
• nptools.cabal +18/−1
• starecho.hs +42/−0
• summ.hs +9/−2
• timer.hs +89/−0
• x-printable.hs +3/−0

@@ -1,7 +1,29 @@ import System.Environment (getArgs)+import Control.Arrow import Control.Monad import qualified Data.ByteString as B++usage :: String -> a+usage msg =+  error . unlines $+    [""+    ,"Usage: bufferize [-o <outfile>]* <infile>* -- <infile>*"+    ,""+    ,msg]++argv :: [String] -> ([String],[String])+argv ("-o":out:xs)  = first (out:) (argv xs)+argv ("-o":[])      = usage "filename expected after -o"+argv ("--":xs)      = ([], xs)+argv (('-':x):_)    = usage $ "Unpected option -" ++ x+argv (x:xs)         = second (x:) (argv xs)+argv []             = ([],[])+ main :: IO () main = do args  <- getArgs-          when (null args)  $ B.putStr =<< B.getContents-          forM_ args        $ B.putStr <=< B.readFile+          let (outputs,inputs) = argv args+              write s = do+                when (null outputs) $ B.putStr s+                forM_ outputs       $ flip B.writeFile s+          when (null inputs)  $ write =<< B.getContents+          forM_ inputs        $ write <=< B.readFile

@@ -1,3 +1,5 @@+import System.IO+ color :: Int -> String -> String color n = ("\^[["++) . shows n . ('m':) . (++ "\^[[m") @@ -7,4 +9,6 @@ colorDiffLine xs         = xs  main :: IO ()-main = interact (unlines . map colorDiffLine . lines)+main = hSetEncoding stdin latin1 >>+       hSetEncoding stdout latin1 >>+       interact (unlines . map colorDiffLine . lines)

@@ -0,0 +1,17 @@+import System.Exit+import System.IO++unesc :: String -> String+unesc [] = []+unesc ('%':'2':'5':xs) = '%':unesc xs+unesc ('%':'0':'A':xs) = '\n':unesc xs+unesc (x:xs) = x:unesc xs++main :: IO ()+main = do hSetEncoding stdin utf8+          inp <- getContents+          case dropWhile p $ lines inp of+            ['D':' ':xs,"OK"] -> putStrLn (unesc xs)+            _ -> exitFailure+  where p ('D':' ':_) = False+        p _ = True

@@ -19,28 +19,48 @@ sgr0 :: String sgr0 = "\SI" -blue, magenta, green, noColor :: String+blue, magenta, green, red, noColor :: String blue     = color Blue magenta  = color Magenta green    = color Green+red      = color Red noColor  = noLength $ setSGRCode [] ++ sgr0 -main :: IO ()-main = do -  ref <- head . lines <$> run "git symbolic-ref HEAD 2> /dev/null"-  when (null ref) exitFailure+statsInfo :: IO String+statsInfo = do   gitstat <-  fmap lines . run $ "git status 2> /dev/null"          -|-  egrep "(# Untracked|# Changes|# Changed but not updated:|# Your branch)"-  let f msg   = listToMaybe . map (takeWhile isDigit . dropWhile (not . isDigit)) $ egrep msg gitstat+  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 "-  putStrLn . concat $-    ["±"-    ,blue,":",magenta,drop (length "refs/heads/") ref-    ,green+  return . concat $+    [green     ,['!' | "# Changes to be committed:"  `elem` gitstat]     ,['?' | "# Untracked files:"          `elem` gitstat          || "# Changed but not updated:"  `elem` gitstat]     ,maybe "" ((blue++":"++green++"-")++) behind     ,maybe "" ((blue++":"++green++"+")++) ahead+    ]++isBareRepo :: IO Bool+isBareRepo = readbool =<< run "git config core.bare"+  where readbool "false\n"  = return False+        readbool "true\n"   = return True+        readbool s          = fail ("Unexpected result: " ++ show s)++cond :: a -> a -> Bool -> a+cond x y b = if b then x else y++main :: IO ()+main = do+  ref <- head . lines <$> run "git symbolic-ref HEAD 2> /dev/null"+  when (null ref) exitFailure+  stats <- catch statsInfo . const $+             ((blue++":")++) . cond (green ++ "bare") (red ++ "ERR")+               <$> isBareRepo+  putStrLn . concat $+    ["±"+    ,blue,":",magenta,drop (length "refs/heads/") ref+    ,stats     ,noColor]

@@ -0,0 +1,23 @@+import Data.Char (isDigit)+import System.Environment (getArgs)+import System.IO (hPutStr,stderr)+import System.Exit (exitFailure)++nest :: Int -> String -> String+nest i = unlines . map (s++) . lines+  where s = replicate i ' '++main :: IO ()+main = do args <- getArgs+          case args of+            [arg] | all isDigit arg -> putStr . nest (read arg) =<< getContents+            _ -> do hPutStr stderr . unlines $+                      ["Usage: nest <number>"+                      ,""+                      ,"This program will write on standard output the contents"+                      ,"read on standard input but nested by <number> spaces."+                      ,""+                      ,"Each gets indented by <number> spaces more."+                      ]+                    exitFailure+

@@ -1,6 +1,6 @@ Name:           nptools Cabal-Version:  >=1.4-Version:        0.2.1+Version:        0.2.2 License:        BSD3 License-File:   LICENSE Copyright:      (c) Nicolas Pouillard@@ -114,4 +114,21 @@  executable cp-rescue     main-is: cp-rescue.hs+    ghc-options: -Wall -Odph++executable timer+    main-is: timer.hs+    Build-depends: unix<3+    ghc-options: -Wall -Odph++executable nest+    main-is: nest.hs+    ghc-options: -Wall -Odph++executable getpin+    main-is: getpin.hs+    ghc-options: -Wall -Odph++executable starecho+    main-is: starecho.hs     ghc-options: -Wall -Odph

@@ -0,0 +1,42 @@+import System.IO+import Control.Monad+import System.Environment++main :: IO ()+main = do hPutStrLn stderr "Listening..."+          hSetBuffering stdin NoBuffering+          hSetBuffering stderr NoBuffering+          hSetEcho stdin False+          args <- getArgs+          when (not . null $ args) $ hPutStrLn stderr "Usage: starecho\n\nThis programs reads on stdin, echoes to stderr, and finally prints the results on stdout."+          putStrLn =<< loop ""+  where+    -- `s' holds the accumulated read string+    loop s = do c <- getChar+                proc c s++    -- tells what to do with the current char+    proc '\n'   = finish+    proc '\DEL' = del+    proc '\b'   = del+    proc c      = lineAndLoop c++    -- show a line and continue reading+    lineAndLoop c s = puts (showLine c (length s)) >> loop (c : s)++    showLine c n = '\r' : replicate n '*' ++ [c]++    -- Erase a char, visually and internally.+    del (_ : c : s) = erase >> proc c s+    del _           = erase >> loop ""++    -- Clear the line and return the string+    finish s = do puts $ '\r' : replicate (length s) ' ' ++ ['\r']+                  return $ reverse s++    -- To erase the previous char, one first go back, draw a space,+    -- and go back again.+    erase = puts "\b \b"++    puts = hPutStr stderr+

@@ -3,5 +3,12 @@ main :: IO () main = do   argc <- length `fmap` getArgs-  when (argc /= 0) $ fail "summ does not expect arguments, it is reading from stdin"-  putStrLn . show . sum . map (read :: String -> Integer) . lines =<< getContents+  when (argc /= 0) . fail . unlines $ ["summ does not expect arguments."+                                      ,"It reads numbers from stdin and finally prints the sum"]+  print . sum               -- sum them up+        . map readI         -- turns numbers into integers+        . concatMap words   -- split words+        . lines             -- split lines+        =<< getContents     -- reads stdin+  where readI :: String -> Integer+        readI = read

@@ -0,0 +1,89 @@+{-# LANGUAGE PatternGuards #-}+import Prelude hiding (min,and)+import System.Environment (getArgs)+import Control.Concurrent (threadDelay)+import System.IO (hFlush, stdout)+import Control.Monad (forM_, when)+import Data.Char (isDigit)++-- one day this would be standard (the Applicative version)+void :: IO a -> IO ()+void x = x >> return ()++setupTitle :: String -> IO ()+setupTitle title = do+  putStr "\ESC]2;"+  putStr title+  putStr "\a"+  hFlush stdout++redrawLn :: String -> IO ()+redrawLn str = do+  putStr "\r\ESC[K"+  putStr str+  hFlush stdout++type Microseconds = Int+type Seconds = Int+type Minutes = Int++minute, minutes :: Minutes -> Microseconds+second, seconds :: Seconds -> Microseconds+seconds = (*1000000)+minutes = (*60) . seconds+second  = seconds+minute  = minutes++sleep_ :: Microseconds -> IO ()+sleep_ = void . threadDelay++countDown :: Int -> (Int -> IO ()) -> IO ()+countDown i = forM_ (reverse [1..i])++(<|) :: a -> (a -> b) -> b+(<|) x f = f x++timerDisplay :: String -> IO ()+timerDisplay s = do setupTitle $ "Timer: " ++ s+                    redrawLn $ s++showTime :: Minutes -> Seconds -> String+showTime min sec = f min "minutes" `and` f sec "seconds" where+  f x s | x == 0     = ""+        | otherwise  = show x ++ " " ++ s+  "" `and` x   = x+  x  `and` ""  = x+  x  `and` y   = x ++ " and " ++ y++remainingTime :: Minutes -> Seconds -> IO ()+remainingTime min sec+  = timerDisplay $ "Remaining time: "++showTime min sec++"..."++timer :: Int -> Int -> IO ()+timer min sec = do+  countDown sec     $ \i ->+    remainingTime min i >> sleep_ (1<|second)++  countDown (min-1) $ \i ->+    remainingTime (i+1) 0 >> sleep_ (1<|minute)++  when (min>=1) $+    countDown 60 $ \i ->+      remainingTime 0 i >> sleep_ (1<|second)++  timerDisplay "Time done!\07"++  forM_ [1 :: Int ..] $ \i -> do+    sleep_ (1<|minute)+    timerDisplay $ "Time passed since " ++ showTime i 0 ++ "!\07"++main :: IO ()+main = do+  args <- getArgs+  case args of+    [dur] | (min,sec') <- break (==':') dur,+            sec <- drop 1 sec',+            all isDigit min,+            all isDigit sec ->+         timer (read min) (if null sec then 0 else read sec)+    _ -> error "Duration in minutes (or minutes:seconds) expected as argument"

@@ -2,10 +2,13 @@ import Numeric import Data.Char import System.Environment+import System.IO  main :: IO () main = do   args <- getArgs+  hSetEncoding stdin latin1+  hSetEncoding stdout latin1   case args of     ["encode"] -> interact encode     ["decode"] -> interact decode