Mundanities.hs

   1 -- This file is part of Intricacy
   2 -- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 module Mundanities where
  12 import           Control.Applicative
  13 import           Control.Arrow
  14 import           Control.Monad
  15 import           Control.Monad.Catch    (MonadMask, catch, handle)
  16 import           Control.Monad.IO.Class (MonadIO)
  17 import qualified Data.ByteString        as BS
  18 import qualified Data.ByteString.Char8  as BSC
  19 import           Data.List
  20 import           Data.Maybe
  21 import           Paths_intricacy
  22 import           System.Directory
  23 import           System.Environment     (getEnv)
  24 import           System.FilePath
  25
  26 catchIO :: IO a -> (IOError -> IO a) -> IO a
  27 catchIO = catch
  28
  29 ignoreIOErr :: (MonadIO m, MonadMask m, Monoid a) => m a -> m a
  30 ignoreIOErr = handle ((\_ -> return mempty) :: (Monad m, Monoid a) => IOError -> m a)
  31
  32 ignoreIOErrAlt :: (MonadIO m, MonadMask m, Alternative f) => m (f a) -> m (f a)
  33 ignoreIOErrAlt = handle ((\_ -> return empty) :: (Monad m, Alternative f) => IOError -> m (f a))
  34
  35 unlessIOErr :: (MonadIO m, MonadMask m) => m Bool -> m Bool
  36 unlessIOErr = (fromMaybe False <$>) . ignoreIOErrAlt . (Just <$>)
  37
  38 readReadFile :: (Read a) => FilePath -> IO (Maybe a)
  39 readReadFile file = ignoreIOErrAlt $ tryRead . BSC.unpack <$> BS.readFile file
  40
  41 tryRead :: (Read a) => String -> Maybe a
  42 tryRead = (fst <$>) . listToMaybe . reads
  43
  44 readStrings :: FilePath -> IO [String]
  45 readStrings file = ignoreIOErr $ lines . BSC.unpack <$> BS.readFile file
  46
  47 writeReadFile :: (Show a) => FilePath -> a -> IO ()
  48 writeReadFile file x = do
  49     mkdirhierto file
  50     BS.writeFile file $ BSC.pack $ show x
  51
  52 writeStrings :: FilePath -> [String] -> IO ()
  53 writeStrings file x = do
  54     mkdirhierto file
  55     BS.writeFile file $ BSC.pack $ unlines x
  56
  57 confFilePath :: FilePath -> IO FilePath
  58 confFilePath str = (++(pathSeparator:str)) <$>
  59     catchIO (getEnv "INTRICACY_PATH")
  60         (const $ getAppUserDataDirectory "intricacy")
  61
  62 getDataPath :: FilePath -> IO FilePath
  63 getDataPath = getDataFileName
  64
  65 makeConfDir :: IO ()
  66 makeConfDir = confFilePath "" >>= createDirectoryIfMissing False
  67
  68 fileExists :: FilePath -> IO Bool
  69 fileExists = unlessIOErr . doesFileExist
  70
  71 mkdirhierto :: FilePath -> IO ()
  72 mkdirhierto = mkdirhier . takeDirectory
  73
  74 mkdirhier :: FilePath -> IO ()
  75 mkdirhier = createDirectoryIfMissing True
  76
  77 getDirContentsRec :: FilePath -> IO [FilePath]
  78 getDirContentsRec path = ignoreIOErr $ do
  79     contents <- map ((path++[pathSeparator])++) . filter ((/='.').head) <$> getDirectoryContents path
  80     annotated <- (\p -> (,) p <$> doesDirectoryExist p) `mapM` contents
  81     let (dirs,files) = join (***) (map fst) $ partition snd annotated
  82     (files++) . concat <$> getDirContentsRec `mapM` dirs
  83
  84 fullLockPath path = if isAbsolute path
  85     then return path
  86     else (++(pathSeparator:path)) <$> confFilePath "locks"