Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 53 lines (42 sloc) 1.301 kb
f95167ad »
2007-08-15 Add missing BlingBling
1 module BlingBling where
2
29815fc4 »
2008-09-02 can I has teh bling?
3 import qualified Progress
4
f95167ad »
2007-08-15 Add missing BlingBling
5 import System.IO
29815fc4 »
2008-09-02 can I has teh bling?
6 import Control.Exception as Exception (bracket)
f95167ad »
2007-08-15 Add missing BlingBling
7
8 -- what nobody needs but everyone wants...
9
10 -- FIXME: do something more fun here
87d875b3 »
2008-03-15 Wall police
11 forMbling :: [a] -> (a -> IO b) -> IO [b]
29815fc4 »
2008-09-02 can I has teh bling?
12 forMbling lst f =
13 withBuffering stdout NoBuffering $ do
f95167ad »
2007-08-15 Add missing BlingBling
14 xs <- mapM (\x -> putStr "." >> f x) lst
15 putStrLn ""
16 return xs
29815fc4 »
2008-09-02 can I has teh bling?
17
18 blingProgress :: Progress.Progress s String a -> IO a
19 blingProgress progress = do
20 isTerm <- hIsTerminalDevice stdout
21 if isTerm
22 then canIHasTehBling
23 else boring
24
25 where
26 boring = Progress.fold (flip const) fail return progress
27
28 canIHasTehBling =
29 withBuffering stdout NoBuffering $ do
30 putChar (fst (char 0))
31 result <- spin 0 progress
32 putStr "\b \b"
33 return result
34
35 spin _ (Progress.Fail e) = fail e
36 spin _ (Progress.Done r) = return r
37 spin n (Progress.Step _ p) = do
38 putStr ['\b', c]
39 spin n' p
40 where (c, n') = char n
41
42 char :: Int -> (Char, Int)
43 char 0 = ('/', 1)
44 char 1 = ('-', 2)
45 char 2 = ('\\', 3)
46 char _ = ('|', 0)
47
48 withBuffering :: Handle -> BufferMode -> IO a -> IO a
49 withBuffering hnd mode action =
50 Exception.bracket
51 (hGetBuffering hnd) (hSetBuffering hnd)
52 (\_ -> hSetBuffering hnd mode >> action)
Something went wrong with that request. Please try again.