{-# LANGUAGE ScopedTypeVariables #-}
module Gamgine.System where
import System.Environment (getProgName, getEnv)
import System.Directory (createDirectoryIfMissing, getAppUserDataDirectory, getDirectoryContents)
import Data.List (takeWhile)
import Data.Time.Clock (getCurrentTime, utctDay)
import Data.Time.Calendar (toGregorian)
import Control.Exception (try)
import Control.Monad (filterM)
normalizedProgName :: IO (String)
normalizedProgName :: IO String
normalizedProgName = do
String
pn <- IO String
getProgName
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') String
pn
getCurrentDate :: IO (Integer,Int,Int)
getCurrentDate :: IO (Integer, Int, Int)
getCurrentDate = IO UTCTime
getCurrentTime IO UTCTime
-> (UTCTime -> IO (Integer, Int, Int)) -> IO (Integer, Int, Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Integer, Int, Int) -> IO (Integer, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Int, Int) -> IO (Integer, Int, Int))
-> (UTCTime -> (Integer, Int, Int))
-> UTCTime
-> IO (Integer, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian (Day -> (Integer, Int, Int))
-> (UTCTime -> Day) -> UTCTime -> (Integer, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay
getEnvOrDefault :: String -> String -> IO String
getEnvOrDefault :: String -> String -> IO String
getEnvOrDefault String
envVar String
defaultValue = do
Either IOError String
result <- IO String -> IO (Either IOError String)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO String -> IO (Either IOError String))
-> IO String -> IO (Either IOError String)
forall a b. (a -> b) -> a -> b
$ String -> IO String
getEnv String
envVar
case Either IOError String
result of
Right String
value -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
value
Left (IOError
_ :: IOError) -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
defaultValue
appDirectory :: IO String
appDirectory = IO String
normalizedProgName IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
pn -> String -> IO String
getAppUserDataDirectory String
pn
getAndCreateAppDir :: IO (FilePath)
getAndCreateAppDir :: IO String
getAndCreateAppDir = do
String
dir <- IO String
appDirectory
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
getDirContents :: FilePath -> IO [FilePath]
getDirContents :: String -> IO [String]
getDirContents String
dir = do
[String]
entries <- String -> IO [String]
getDirectoryContents String
dir
(String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
forall {m :: * -> *}. Monad m => String -> m Bool
notDots [String]
entries
where
notDots :: String -> m Bool
notDots String
entry = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (Bool -> Bool) -> Bool -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String
"." String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
entry Bool -> Bool -> Bool
|| String
".." String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
entry