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, liftIO)
  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 warnIOErrAlt :: (MonadIO m, MonadMask m, Alternative f) => m (f a) -> m (f a)
  36 warnIOErrAlt = handle ((\e -> liftIO (print e) >> return empty) :: (MonadIO m, Alternative f) => IOError -> m (f a))
  37
  38 unlessIOErr :: (MonadIO m, MonadMask m) => m Bool -> m Bool
  39 unlessIOErr = (fromMaybe False <$>) . ignoreIOErrAlt . (Just <$>)
  40
  41 readReadFile :: (Read a) => FilePath -> IO (Maybe a)
  42 readReadFile file = ignoreIOErrAlt $ tryRead . BSC.unpack <$> BS.readFile file
  43
  44 tryRead :: (Read a) => String -> Maybe a
  45 tryRead = (fst <$>) . listToMaybe . reads
  46
  47 readStrings :: FilePath -> IO [String]
  48 readStrings file = ignoreIOErr $ lines . BSC.unpack <$> BS.readFile file
  49
  50 writeReadFile :: (Show a) => FilePath -> a -> IO ()
  51 writeReadFile file x = do
  52     mkdirhierto file
  53     BS.writeFile file $ BSC.pack $ show x
  54
  55 writeStrings :: FilePath -> [String] -> IO ()
  56 writeStrings file x = do
  57     mkdirhierto file
  58     BS.writeFile file $ BSC.pack $ unlines x
  59
  60 confFilePath :: FilePath -> IO FilePath
  61 confFilePath str = (++(pathSeparator:str)) <$>
  62     catchIO (getEnv "INTRICACY_PATH")
  63         (const $ getAppUserDataDirectory "intricacy")
  64
  65 getDataPath :: FilePath -> IO FilePath
  66 getDataPath = getDataFileName
  67
  68 makeConfDir :: IO ()
  69 makeConfDir = confFilePath "" >>= createDirectoryIfMissing False
  70
  71 fileExists :: FilePath -> IO Bool
  72 fileExists = unlessIOErr . doesFileExist
  73
  74 mkdirhierto :: FilePath -> IO ()
  75 mkdirhierto = mkdirhier . takeDirectory
  76
  77 mkdirhier :: FilePath -> IO ()
  78 mkdirhier = createDirectoryIfMissing True
  79
  80 getDirContentsRec :: FilePath -> IO [FilePath]
  81 getDirContentsRec path = ignoreIOErr $ do
  82     contents <- map ((path++[pathSeparator])++) . filter ((/='.').head) <$> getDirectoryContents path
  83     annotated <- (\p -> (,) p <$> doesDirectoryExist p) `mapM` contents
  84     let (dirs,files) = join (***) (map fst) $ partition snd annotated
  85     (files++) . concat <$> getDirContentsRec `mapM` dirs
  86
  87 fullLockPath path = if isAbsolute path
  88     then return path
  89     else do
  90         homePath <- getHomeDirectory
  91         locksPath <- confFilePath "locks"
  92         return $ if take 2 path == "~/"
  93             then homePath </> drop 2 path
  94             else locksPath </> path