format-status 0.1.2.4 → 0.2.0.0

raw patch · 2 files changed

+45/−31 lines, 2 filesdep +stm

Dependencies added: stm

Files

• Main.lhs +42/−29
• format-status.cabal +3/−2

@@ -2,6 +2,7 @@ > module Main where  > import Control.Concurrent+> import Control.Concurrent.STM > import qualified Data.Text as T > import qualified Data.Text.IO as TIO > import Control.Exception@@ -9,59 +10,71 @@ > import qualified System.IO.Error as E > import Data.Time > import System.IO+> import System.Environment > import System.Locale > import qualified Data.Concurrent.Queue as Q  > data Msg = Line T.Text >          | Tick->          | Done->          | Error IOError +> data EMsg = Done+>           | Error IOError+ > gitLine :: IO (Either IOError T.Text) > gitLine = try TIO.getLine -> ticksProc :: (Q.PutQueue q IO) => Int -> q Msg -> IO ()+> ticksProc :: (Q.PutQueue q STM) => Int -> q Msg -> IO () > ticksProc interval chan = do >   threadDelay (interval * 100)->   Q.put chan $! Tick+>   atomically $ Q.put chan $! Tick >   ticksProc interval chan -> linesProc :: (Q.PutQueue q IO) => q Msg -> IO ()-> linesProc chan = do+> linesProc :: (Q.PutQueue q STM) => q EMsg -> q Msg -> IO ()+> linesProc echan chan = do >   l <- gitLine >   case l of >     Left err  >       | E.isEOFError err -> do->         Q.put chan Done+>         atomically $ Q.put echan Done >       | otherwise -> do->         Q.put chan $ Error err+>         atomically $ Q.put echan $ Error err >     Right line -> do->       Q.put chan $ Line line->       linesProc chan+>       atomically $ Q.put chan $ Line line+>       linesProc echan chan -> output :: (Q.TakeQueue q IO) => T.Text -> q Msg -> IO ()-> output state chan = do->   m <- Q.take chan->   case m of->     Error e ->->       throwIO e->     Done ->->       return ()->     Tick ->->       display state chan->     Line line ->->       display line chan+> output :: (Q.TakeQueue q STM) => (T.Text -> IO ()) -> q EMsg -> q Msg -> T.Text -> IO ()+> output disp echan chan state = do+>   a <- atomically $ do+>       m <- Q.take chan+>       return $ do+>         case m of+>           Tick -> do+>             disp state+>             output disp echan chan state+>           Line line -> do+>             disp line+>             output disp echan chan line+>     `orElse` do+>       m <- Q.take echan+>       return $ do+>         case m of+>           Error e ->+>             throwIO e+>           Done ->+>             return ()+>   a -> display :: (Q.TakeQueue q IO) => T.Text -> q Msg -> IO ()-> display txt chan = do+> display :: T.Text -> T.Text -> IO ()+> display sep txt = do >   time <- getZonedTime->   TIO.putStrLn $ T.concat [txt, " | ^fg(#00ff00)", T.pack $ formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") time]+>   TIO.putStrLn $ T.concat [txt, sep, T.pack $ formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") time] >   hFlush stdout->   output txt chan  > main :: IO () > main = do->   chan <- newEmptyMVar->   _ <- forkIO $ linesProc chan+>   istate <- getArgs+>   chan <- newEmptyTMVarIO+>   echan <- newEmptyTMVarIO+>   _ <- forkIO $ linesProc echan chan >   _ <- forkIO $ ticksProc 500 chan->   output "" chan+>   output (display $ T.pack $ unwords $ istate) echan chan ""

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                format-status-version:             0.1.2.4+version:             0.2.0.0 synopsis:            A utility for writing the date to dzen2. -- description:          license:             MIT@@ -23,7 +23,8 @@                        text >=1.1 && <1.2,                        time >=1.4 && <1.5,                        old-locale >=1.0.0 && <1.1.0,-                       data-concurrent-queue >= 0.3.0.0 && <0.4.0.0+                       data-concurrent-queue >= 0.3.0.0 && <0.4.0.0,+                       stm >=2.4 && <2.5   -- hs-source-dirs:         default-language:    Haskell2010   ghc-options:         -O2 -threaded "-with-rtsopts=-N"