Initial commit

src/IO/Error.hs

@@ -0,0 +1,23 @@
+{-# OPTIONS_HADDOCK ignore-exports #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module IO.Error where
+
+
+import Control.Exception
+import Control.Monad
+  (
+    mzero
+  , MonadPlus
+  )
+import Data.Typeable
+
+
+data FmIOException = FileDoesNotExist String
+                   | PathNotAbsolute String
+                   | FileNotExecutable String
+  deriving (Show, Typeable)
+
+
+instance Exception FmIOException
+

src/IO/File.hs

@@ -0,0 +1,68 @@
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+module IO.File (
+    openFile
+  , executeFile
+  ) where
+
+
+import Control.Exception
+  (
+    throw
+  )
+import Control.Monad
+  (
+    unless
+  , void
+  )
+import IO.Error
+import System.Directory
+  (
+    doesFileExist
+  , getPermissions
+  , executable
+  )
+import System.FilePath.Posix
+  (
+    isAbsolute
+  )
+import System.Process
+  (
+    spawnProcess
+  , ProcessHandle
+  )
+
+
+-- |Opens a file appropriately by invoking xdg-open.
+--
+-- This will throw an exception if the filepath is not absolute
+-- or the file does not exist.
+openFile :: FilePath          -- ^ absolute path to file
+         -> IO ProcessHandle
+openFile fp = do
+  fileSanityThrow fp
+  spawnProcess "xdg-open" [fp]
+
+
+-- |Executes a program with the given arguments.
+--
+-- This will throw an exception if the filepath is not absolute
+-- or the file does not exist. It will also throw an exception
+-- if the file is not executable.
+executeFile :: FilePath          -- ^ absolute path to program
+            -> [String]          -- ^ arguments
+            -> IO ProcessHandle
+executeFile fp args = do
+  fileSanityThrow fp
+  p <- getPermissions fp
+  unless (executable p) (throw $ FileNotExecutable fp)
+  spawnProcess fp args
+
+
+-- Throws an exception if the filepath is not absolute
+-- or the file does not exist.
+fileSanityThrow :: FilePath -> IO ()
+fileSanityThrow fp = do
+  unless (isAbsolute fp) (throw $ PathNotAbsolute fp)
+  exists <- doesFileExist fp
+  unless exists (throw $ FileDoesNotExist fp)

src/IO/Utils.hs

@@ -0,0 +1,23 @@
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+module IO.Utils where
+
+
+import Control.Concurrent.STM
+  (
+    atomically
+  )
+import Control.Concurrent.STM.TVar
+  (
+    writeTVar
+  , modifyTVar
+  , TVar
+  )
+
+
+writeTVarIO :: TVar a -> a -> IO ()
+writeTVarIO tvar val = atomically $ writeTVar tvar val
+
+
+modifyTVarIO :: TVar a -> (a -> a) -> IO ()
+modifyTVarIO tvar f = atomically $ modifyTVar tvar f