module System.FileSystem.IO
   ( takeFile
   , captureDir
   , capture
   , releaseEnd
   , release
   , releaseHere
     )
       where

import Control.Applicative (pure, liftA2)
import System.FilePath (splitPath, dropFileName, takeFileName, combine
                       ,pathSeparator, makeRelative)
import Data.ByteString (writeFile,readFile)
import System.Directory (getModificationTime, getDirectoryContents
                       , doesFileExist, doesDirectoryExist
                       , createDirectoryIfMissing)
import Data.Maybe (catMaybes)
import Data.Monoid (mconcat)
import Control.Arrow ( (&&&) , (|||) , (>>>) )
import Data.List (isSuffixOf)
import Data.ByteString (ByteString)
--
import System.FileSystem.Types
import System.FileSystem.Utils
import System.FileSystem.Operators
import System.FileSystem.Instances
import System.FileSystem.Across

-- | Create a 'File' from a 'FilePath' to a \"real world\" file.
takeFile :: FilePath -> IO File
takeFile = comb File (comb FD Data.ByteString.readFile
                              getModificationTime) $
                      pure . takeFileName

takePath :: AbsPath -> FilePath -> IO Path
takePath afp = comb Path (pure . splitPath . dropFileName . makeRelative afp) $
                          fmap Just . takeFile

getDirContents :: FilePath -> IO [FilePath]
getDirContents = uncurry (liftA2 $ fmap . combine) . (pure &&& getDirectoryContents)

doesDirectoryExist' :: FilePath -> IO Bool
doesDirectoryExist' = let suffs = uncurry (||) . (isSuffixOf (pathSeparator : "." )
                                              &&& isSuffixOf (pathSeparator : ".."))
                      in  uncurry (liftA2 (&&))
                      . ( doesDirectoryExist &&& pure . not . suffs )

type AbsPath = FilePath

capturePaths :: AbsPath -> FilePath -> IO [Path]
capturePaths afp =
    fmap (mconcat . catMaybes)
  . bind (mapM $ options [ ( doesFileExist , fmap pure . takePath afp )
                         , ( doesDirectoryExist' , capturePaths afp )
                         ]
          )
  . getDirContents

-- | Create a complete 'FileSystem' from an existing directory.
captureDir :: FilePath -> IO FileSystem
captureDir = fmap buildFileSystem . ( capturePaths $$ )

-- | Create a complete 'FileSystem' from the current working directory.
capture :: IO FileSystem
capture = captureDir "."

writeFileIfMissing :: Bool -> FilePath -> ByteString -> IO ()
writeFileIfMissing b fp cnt =
 do let dir = dropFileName fp
    createDirectoryIfMissing b dir
    Data.ByteString.writeFile fp cnt

-- | @releaseEnd fp c fs@ write in @fp@ the 'FileSystem' @fs@, and execute @c@ at the end.
releaseEnd :: FilePath -> IO a -> FileSystem -> IO a
releaseEnd fp0 =
 foldFileSystem fp0 (Left $
    \fp -> let f =  createDirectoryIfMissing True . combine fp 
                ||| uncurry (writeFileIfMissing True) . (combine fp . getFN &&& getCnt . getFD)
           in  (>>>) f . flip (>>)
      )

-- | @release fp fs@ write in @fp@ the 'FileSystem' @fs@.
release :: FilePath -> FileSystem -> IO ()
release = ($ return ()) . releaseEnd

-- | @releaseHere fs@ write in the current working directory the 'FileSystem' @fs@.
releaseHere :: FileSystem -> IO ()
releaseHere = release "."