module T4.Storage where

import T4.Data
import Data.List
import Data.Maybe
import qualified Data.Set as S
import Data.Yaml
import Text.Regex.TDFA
import System.FilePath
import System.Directory
import System.Environment
import Control.Monad.Extra

fileName :: Clock -> FilePath
fileName :: Clock -> [Char]
fileName Clock
clock = SimpleLocalTime -> [Char]
dateString (Clock -> SimpleLocalTime
time Clock
clock) [Char] -> [Char] -> [Char]
<.> [Char]
"yml"

loadDataFromDir :: FilePath -> IO Clocks
loadDataFromDir :: [Char] -> IO Clocks
loadDataFromDir [Char]
dir = do
  ymlFiles <- ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
".yml" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
listDirectory [Char]
dir
  S.fromList <$> concatMapM decodeFileThrow ((dir </>) <$> ymlFiles)

writeDataToDir :: FilePath -> Clocks -> IO ()
writeDataToDir :: [Char] -> Clocks -> IO ()
writeDataToDir [Char]
dir Clocks
clocks = do
  Map Day Clocks -> (Clocks -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Clocks -> Map Day Clocks
dayGroups Clocks
clocks) ((Clocks -> IO ()) -> IO ()) -> (Clocks -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Clocks
dayGroup -> do
    [Char] -> Clocks -> IO ()
forall a. ToJSON a => [Char] -> a -> IO ()
encodeFile ([Char]
dir [Char] -> [Char] -> [Char]
</> Clock -> [Char]
fileName (Clocks -> Clock
forall a. Set a -> a
S.findMin Clocks
dayGroup)) Clocks
dayGroup

addClockToDir :: FilePath -> Clock -> IO ()
addClockToDir :: [Char] -> Clock -> IO ()
addClockToDir [Char]
dir Clock
clock = do
  let file :: [Char]
file = [Char]
dir [Char] -> [Char] -> [Char]
</> Clock -> [Char]
fileName Clock
clock
  other <- [Clock] -> Clocks
forall a. Ord a => [a] -> Set a
S.fromList ([Clock] -> Clocks) -> IO [Clock] -> IO Clocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool -> IO [Clock] -> IO [Clock] -> IO [Clock]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ([Char] -> IO Bool
doesFileExist [Char]
file)
                            ([Char] -> IO [Clock]
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => [Char] -> m a
decodeFileThrow [Char]
file)
                            ([Clock] -> IO [Clock]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
  writeDataToDir dir $ S.insert clock other

getStorageDirectoryPath :: IO FilePath
getStorageDirectoryPath :: IO [Char]
getStorageDirectoryPath = do
  hd <- IO [Char]
getHomeDirectory
  fromMaybe (hd </> ".t4-data") <$> lookupEnv "T4DIR"

isStorageDirectory :: FilePath -> IO Bool
isStorageDirectory :: [Char] -> IO Bool
isStorageDirectory [Char]
sd = [IO Bool] -> IO Bool
forall (m :: * -> *). Monad m => [m Bool] -> m Bool
andM [IO Bool
exists, IO Bool
readablePerm, IO Bool
writablePerm, IO Bool
onlyT4Yaml]
  where exists :: IO Bool
exists        = [Char] -> IO Bool
doesDirectoryExist [Char]
sd
        readablePerm :: IO Bool
readablePerm  = Permissions -> Bool
readable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Permissions
getPermissions [Char]
sd
        writablePerm :: IO Bool
writablePerm  = Permissions -> Bool
writable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Permissions
getPermissions [Char]
sd
        onlyT4Yaml :: IO Bool
onlyT4Yaml    = ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Char] -> [Char] -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ [Char]
regex) ([[Char]] -> Bool) -> IO [[Char]] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
listDirectory [Char]
sd
        regex :: [Char]
regex         = [Char]
"^[0-9]{4}-[0-9]{2}-[0-9]{2}.yml$" :: String

getStorageDirectory :: IO FilePath
getStorageDirectory :: IO [Char]
getStorageDirectory = do
  sd <- IO [Char]
getStorageDirectoryPath
  unlessM (doesDirectoryExist sd) $
    createDirectory sd
  unlessM (isStorageDirectory sd) $
    fail ("Not a t4 storage directory: " ++ sd)
  return sd