PageRenderTime 42ms CodeModel.GetById 16ms RepoModel.GetById 0ms app.codeStats 0ms

/Angel/Files.hs

http://github.com/jamwt/Angel
Haskell | 33 lines | 29 code | 4 blank | 0 comment | 0 complexity | e3a0168b4f6ad3b1168a761f0f4bc6e2 MD5 | raw file
Possible License(s): BSD-3-Clause
  1. module Angel.Files (getFile, startFileManager) where
  2. import Control.Concurrent.STM
  3. import Control.Concurrent.STM.TChan (readTChan, writeTChan, TChan, newTChan, newTChanIO)
  4. import Control.Monad (forever)
  5. import System.IO (Handle, hClose, openFile, IOMode(..), hIsClosed)
  6. import GHC.IO.Handle (hDuplicate)
  7. import Debug.Trace (trace)
  8. import Angel.Data (GroupConfig(..), FileRequest)
  9. startFileManager req = forever $ fileManager req
  10. fileManager :: TChan FileRequest -> IO ()
  11. fileManager req = do
  12. (path, resp) <- atomically $ readTChan req
  13. mh <- catch (openFile path AppendMode >>= \h-> return $ Just h) (\e-> return Nothing)
  14. case mh of
  15. Just hand -> do
  16. hand' <- hDuplicate hand
  17. hClose hand
  18. atomically $ writeTChan resp (Just hand')
  19. Nothing -> atomically $ writeTChan resp Nothing
  20. fileManager req
  21. getFile :: String -> GroupConfig -> IO Handle
  22. getFile path cfg = do
  23. resp <- newTChanIO
  24. atomically $ writeTChan (fileRequest cfg) (path, resp)
  25. mh <- atomically $ readTChan resp
  26. hand <- case mh of
  27. Just hand -> return hand
  28. Nothing -> error $ "could not open stdout/stderr file " ++ path
  29. return hand