packages feed

FileSystem (empty) → 1.0.0

raw patch · 12 files changed

+1124/−0 lines, 12 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, directory, filepath, mtl, old-time

Files

+ FileSystem.cabal view
@@ -0,0 +1,42 @@+Name:           FileSystem
+Version:        1.0.0
+Author:         Daniel Diaz
+Homepage:       http://ddiaz.asofilak.es/packages/FileSystem
+License:        BSD3
+License-file:   license
+Maintainer:     Daniel Diaz <danieldiaz@asofilak.es>
+Category:       System
+Synopsis:       File system data structure and monad transformer.
+Description:
+   FileSystem allows you to create a virtual file system. This package defines:
+   .
+   * A data structure of a file system, with directories and files.
+   .
+   * A monad transformer which adds a file system environment, where
+     you can do standard system operations, like write and read files
+     or create directories.
+   .
+   * An IO interface for create these virtual file systems from
+     existing real directories.
+Build-type:     Simple
+Cabal-version:  >= 1.6
+
+Library
+  Build-depends:  base == 4.*
+                , mtl == 2.0.*
+                , directory
+                , bytestring == 0.9.*
+                , filepath
+                , old-time
+                , binary == 0.5.*
+  Extensions: GeneralizedNewtypeDeriving
+  Exposed-modules: 
+             System.FileSystem
+           , System.FileSystem.Operators
+           , System.FileSystem.Computations
+           , System.FileSystem.IO
+           , System.FileSystem.Types
+           , System.FileSystem.Instances
+           , System.FileSystem.Across
+           , System.FileSystem.Utils
+           , System.FileSystem.Class
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ System/FileSystem.hs view
@@ -0,0 +1,330 @@+
+module System.FileSystem
+  ( -- * Several type synonyms
+    InApp
+  , DirName , FileName
+    -- * Types
+    -- ** @ByteString@
+    -- | A re-export of the 'ByteString' type.
+    -- The content of a 'File' is stored in a 'ByteString'.
+  , ByteString
+    -- ** @ClockTime@
+    -- | A re-export of the 'ClockTime' type.
+    -- 'ClockTime' is used to represents modification times.
+  , ClockTime
+    -- ** @File@
+    -- | The 'File' type and basic functions to operate with it.
+  , File
+  , emptyFile , newFile
+  , getFileName , setFileName
+  , getFileContent , setFileContent
+  , getModifTime , setModifTime
+  , fileSize
+    -- ** @FileSystem@
+  , FileSystem , emptyFileSystem
+    -- * Across the @FileSystem@
+    -- ** Mapping
+  , mapFileSystem
+  , mapFiles
+    -- ** Folding
+  , foldFileSystem
+  , foldFiles
+    -- * Computations over a @FileSystem@
+    -- ** Types
+    -- *** @FST@ monad transformer
+  , FSState
+  , FST , runFST
+  , FS, runFS
+    -- *** List-based paths
+    -- | List-based paths is an alternative to 'FilePath'
+    -- that represents a path as a list of names.
+    --
+    -- While directory paths are a simple list of 'DirName's,
+    -- file paths are a pair: ('DirPath','FileName').
+    -- First component is the directory where the file is,
+    -- and the second is the name of the file.
+    --
+    -- Below you can see a list of examples of how
+    -- to represent several 'FilePath's:
+    --
+    -- > |  FilePath  |   List-based path   |
+    -- > ------------------------------------
+    -- > | "aa\bb\cc" |   ["aa","bb",cc"]   |
+    -- > | "dir\file" |   (["dir"],"file")  |
+    -- > | "a\b\f.hs" |  (["a","b"],"f.hs") |
+  , DirPath , toDirPath , fromDirPath
+  , FPath , toFPath , fromFPath
+    -- ** Computations
+    -- | Computations within a 'FSMonad' environment.
+    -- All functions have a list-based path version (with @L@ at the end),
+    -- and a normal 'FilePath' version.
+    -- Use 'toDirPath' ('toFPath') and 'fromDirPath' ('fromFPath') to change between both formats.
+    --
+    -- Also, to avoid name collisions, function with existing names
+    -- have @fs_@ as preffix.
+
+    -- *** Put/Get @File@ operations
+  , putFileL
+  , putFile
+  , getFileL
+  , getFile
+  , modFileL
+  , modFile
+  , moveFileL
+  , moveFile
+    -- *** Writing and reading
+    -- | Writing and reading files in a 'FSMonad' environment.
+
+    -- **** Pure operations
+  , fs_writeFileL
+  , fs_writeFile
+  , fs_readFileL
+  , fs_readFile
+    -- **** 'IO' monad operations
+  , writeFileTimeL
+  , writeFileTime
+    -- *** @System.Directory@ operations
+    -- | All these functions are analogous to those defined in "System.Directory".
+  , fs_getDirectoryContentsL
+  , fs_getDirectoryContents
+  , fs_doesFileExistL
+  , fs_doesFileExist
+  , fs_doesDirectoryExistL
+  , fs_doesDirectoryExist
+  , fs_createDirectoryL
+  , fs_createDirectory
+  , fs_removeDirectoryL
+  , fs_removeDirectory
+  , fs_removeFileL
+  , fs_removeFile
+  , fs_renameDirectoryL
+  , fs_renameDirectory
+  , fs_renameFileL
+  , fs_renameFile
+  , fs_copyFileL
+  , fs_copyFile
+  , fs_getModificationTimeL
+  , fs_getModificationTime
+    -- * Re-exports
+    -- ** IO interface
+  , module System.FileSystem.IO
+    -- ** Class instances
+    -- | Some needed class instances.
+  , module System.FileSystem.Instances
+    -- ** @FSMonad@ class
+    -- | If you want to use another monad, instead of 'FST',
+    -- make your type instance of the class here defined, 'FSMonad'.
+  , module System.FileSystem.Class
+    ) where
+
+import Data.ByteString (ByteString, length)
+import System.Time (ClockTime,getClockTime)
+import Control.Arrow (first , (***))
+import System.FilePath (splitFileName)
+import Data.Maybe (isJust,fromJust)
+import Control.Monad.State (runStateT,MonadIO,liftIO)
+--
+import System.FileSystem.Types
+import System.FileSystem.Across
+import System.FileSystem.IO
+import System.FileSystem.Computations
+import System.FileSystem.Utils
+import System.FileSystem.Instances
+import System.FileSystem.Class
+
+-- | Create an empty file with the given 'FileName'.
+emptyFile :: FileName -> File
+emptyFile = File emptyFD
+
+-- | Build a new file with an initial 'FileName' and content.
+newFile :: FileName -> ByteString -> File
+newFile = curry $ uncurry (flip setFileContent) . first emptyFile
+
+-- | Get the name of a 'File'.
+getFileName :: File -> FileName
+getFileName = getFN
+
+-- | Rename a 'File' with the given 'FileName'.
+setFileName :: FileName -> File -> File
+setFileName fn f = f { getFN = fn }
+
+-- | Extract the content of a 'File'.
+getFileContent :: File -> ByteString
+getFileContent = getCnt . getFD
+
+-- | Set the content of a 'File' to the given 'ByteString'.
+setFileContent :: ByteString -> File -> File
+setFileContent c f = f { getFD = (getFD f) { getCnt = c } }
+
+-- | Get the last modification time of a 'File'.
+getModifTime :: File -> ClockTime
+getModifTime = getLmt . getFD
+
+-- | Set the last modification time of a 'File'.
+setModifTime :: ClockTime -> File -> File
+setModifTime t f = f { getFD = (getFD f) { getLmt = t } }
+
+-- | Calculate the size of a 'File'.
+fileSize :: File -> Int
+fileSize = Data.ByteString.length . getFileContent
+
+-- | Map a function over all the 'File's of a 'FileSystem'.
+mapFiles :: InApp File -> InApp FileSystem
+mapFiles = mapFileSystem id
+
+-- Computations over the file system.
+
+-- | Puts a file in the given directory. It creates the parent directory if missing.
+putFileL :: FSMonad m
+         => DirPath -- ^ Directory where put the 'File'.
+         -> File
+         -> m ()
+putFileL dp = putPath . Path dp . Just
+
+putFile :: FSMonad m => FilePath -> File -> m ()
+putFile = putFileL . toDirPath
+
+-- | Gets a file from the file system.
+-- It returns 'Nothing' if the 'File' is not found.
+getFileL :: FSMonad m
+         => FPath -- ^ Path where search the 'File'.
+         -> m (Maybe File)
+getFileL = getFl
+
+getFile :: FSMonad m => FilePath -> m (Maybe File)
+getFile = getFileL . toFPath
+
+-- | Modifies a file with the given application. It returns 'True' if the file was found and modified.
+modFileL :: FSMonad m => FPath -> InApp File -> m Bool
+modFileL fp f =
+  do file <- getFileL fp
+     if isJust file
+      then do putFileL (fst fp) $ f $ fromJust file
+              return True
+      else return False
+
+modFile :: FSMonad m => FilePath -> InApp File -> m Bool
+modFile = modFileL . toFPath
+
+-- | Moves a file.
+-- It returns 'True' if the file exists and has been moved.
+moveFileL :: FSMonad m
+          => FPath -- ^ Original path of the 'File'.
+          -> FPath -- ^ New path for the 'File'.
+          -> m Bool
+moveFileL fp1 (dp,fn) =
+  do f1 <- getFileL fp1
+     if isJust f1
+      then do putFileL dp $ setFileName fn $ fromJust f1
+              fs_removeFileL fp1
+              return True
+      else return False
+
+moveFile :: FSMonad m => FilePath -> FilePath -> m Bool
+moveFile = curry $ uncurry moveFileL . pairMap toFPath
+
+-- | Writes a file. If the files already exists, it is overwritten.
+fs_writeFileL :: FSMonad m => FPath -> ByteString -> m ()
+fs_writeFileL = uncurry (.) . (putFileL *** newFile)
+
+fs_writeFile :: FSMonad m => FilePath -> ByteString -> m ()
+fs_writeFile = fs_writeFileL . toFPath
+
+-- | Writes a file, changing its last modification time to the current time.
+-- If the file already exists, it is overwritten.
+-- /Note that MonadIO instance is needed/.
+writeFileTimeL :: (FSMonad m, MonadIO m) => FPath -> ByteString -> m ()
+writeFileTimeL (dp,fn) bs = do t <- liftIO getClockTime
+                               putFileL dp . setModifTime t $ newFile fn bs
+
+writeFileTime :: (FSMonad m, MonadIO m) => FilePath -> ByteString -> m ()
+writeFileTime = writeFileTimeL . toFPath
+
+-- | Reads a file. It returns 'Nothing' if the file can't be found.
+fs_readFileL :: FSMonad m => FPath -> m (Maybe ByteString)
+fs_readFileL = fmap (fmap getFileContent) . getFileL
+
+fs_readFile :: FSMonad m => FilePath -> m (Maybe ByteString)
+fs_readFile = fs_readFileL . toFPath
+
+-- | Returns all directory names and file names located in the given directory.
+-- It returns 'Nothing' if the directory does not exist.
+fs_getDirectoryContentsL :: FSMonad m => DirPath -> m (Maybe ([DirName],[FileName]))
+fs_getDirectoryContentsL = getDirCnt
+
+fs_getDirectoryContents :: FSMonad m => FilePath -> m (Maybe ([DirName],[FileName]))
+fs_getDirectoryContents = fs_getDirectoryContentsL . toDirPath
+
+-- | Checks if a file exists.
+fs_doesFileExistL :: FSMonad m => FPath -> m Bool
+fs_doesFileExistL = checkFExist
+
+fs_doesFileExist :: FSMonad m => FilePath -> m Bool
+fs_doesFileExist = fs_doesFileExistL . toFPath
+
+-- | Checks if a directory exists.
+fs_doesDirectoryExistL :: FSMonad m => DirPath -> m Bool
+fs_doesDirectoryExistL = checkDExist
+
+fs_doesDirectoryExist :: FSMonad m => FilePath -> m Bool
+fs_doesDirectoryExist = fs_doesDirectoryExistL . toDirPath
+
+-- | Creates a new directory. If the directory already exists, it does nothing.
+fs_createDirectoryL :: FSMonad m => DirPath -> m ()
+fs_createDirectoryL = newDir
+
+fs_createDirectory :: FSMonad m => FilePath -> m ()
+fs_createDirectory = fs_createDirectoryL . toDirPath
+
+-- | Removes a directory, with all its content.
+-- If the directory does not exist, it does nothing.
+fs_removeDirectoryL :: FSMonad m => DirPath -> m ()
+fs_removeDirectoryL = rmvDir
+
+fs_removeDirectory :: FSMonad m => FilePath -> m ()
+fs_removeDirectory = fs_removeDirectoryL . toDirPath
+
+-- | Removes a file. If the file does not exist, it does nothing.
+fs_removeFileL :: FSMonad m => FPath -> m ()
+fs_removeFileL = rmvFile
+
+fs_removeFile :: FSMonad m => FilePath -> m ()
+fs_removeFile = fs_removeFileL . toFPath
+
+-- | Renames a directory.
+-- If the directory can't be found, it returns 'False'.
+fs_renameDirectoryL :: FSMonad m => DirPath -> DirPath -> m Bool
+fs_renameDirectoryL = curry rnmDir
+
+fs_renameDirectory :: FSMonad m => FilePath -> FilePath -> m Bool
+fs_renameDirectory = curry $ rnmDir . pairMap toDirPath
+
+-- | Renames a file. First, you must specify the directory where the file is.
+-- If the file can't be found, it returns 'False'.
+fs_renameFileL :: FSMonad m
+               => DirPath  -- ^ Directory where the file is.
+               -> FileName -- ^ Original name.
+               -> FileName -- ^ New name.
+               -> m Bool
+fs_renameFileL dp fn1 fn2 = rnmFile ( (dp,fn1) , (dp,fn2) )
+
+fs_renameFile :: FSMonad m => FilePath -> FileName -> FileName -> m Bool
+fs_renameFile = fs_renameFileL . toDirPath
+
+-- | Copies a file from a location to another.
+-- Returns 'True' if the file was found and copied.
+fs_copyFileL :: FSMonad m => FPath -> FPath -> m Bool
+fs_copyFileL f1 f2 = fs_readFileL f1
+                 >>= maybe ( return False )
+                           ( bind (const $ return True)
+                           . fs_writeFileL f2)
+
+fs_copyFile :: FSMonad m => FilePath -> FilePath -> m Bool
+fs_copyFile = curry $ uncurry fs_copyFileL . pairMap toFPath
+
+-- | Gets the last modification time of a file. It returns 'Nothing' if the file doesn't exist.
+fs_getModificationTimeL :: FSMonad m => FPath -> m (Maybe ClockTime)
+fs_getModificationTimeL = fmap (fmap getModifTime) . getFileL
+
+fs_getModificationTime :: FSMonad m => FilePath -> m (Maybe ClockTime)
+fs_getModificationTime = fs_getModificationTimeL . toFPath
+ System/FileSystem/Across.hs view
@@ -0,0 +1,59 @@+
+module System.FileSystem.Across
+  ( buildFileSystem
+  , fileSystemList
+  , foldFileSystem
+  , foldFiles
+  , mapFileSystem
+    ) where
+
+import Control.Arrow ( (|||) , (***) )
+import System.FilePath ( (</>) )
+--
+import System.FileSystem.Types
+import System.FileSystem.Operators
+import System.FileSystem.Instances
+import System.FileSystem.Utils
+
+buildFileSystem :: [Path] -> FileSystem
+buildFileSystem = foldr (<:) emptyFileSystem
+
+fileSystemList :: FileSystem -> [(Either DirName File,FilePath)]
+fileSystemList = fileSystemList' []
+
+fileSystemList' :: FilePath -> FileSystem -> [(Either DirName File,FilePath)]
+fileSystemList' fp = concat
+                   . fmap (  (\(dn,fs) -> (Left dn,fp) : fileSystemList' (fp </> dn) fs)
+                         ||| (\f -> (Right f,fp) : [] ) ) . dirCnt
+
+-- | Folding function for 'FileSystem's.
+foldFileSystem :: FilePath -- ^ Root path
+          -> Either (FilePath
+                  -> t -> Either DirName File -> t)
+                    (FilePath
+                  -> Either DirName File -> t -> t) -- ^ Folding operator, with current @FilePath@ reference
+          -> t -- ^ The initial value
+          -> FileSystem -- ^ The 'FileSystem' to fold
+          -> t -- ^ Result
+foldFileSystem fp eop = (. dirCnt) . f
+ where
+  f = case eop of
+       Left  op -> foldl . g $ op fp
+       Right op -> foldr . flip . g . flip $ op fp
+  g op = \r ->
+          (\(dn,fs) -> op (foldFileSystem (fp </> dn) eop r fs) (Left dn))
+           ||| op r . Right 
+
+-- | An usage of 'foldFileSystem', folding only 'File's, ignoring the 'FilePath' where they are.
+foldFiles :: Either (t -> File -> t) (File -> t -> t)
+          -> t -> FileSystem -> t
+foldFiles = foldFileSystem [] . f
+ where
+  f =  (\op -> (\_ t eit -> const t |||       op  t $ eit) )
+   <|> (\op -> (\_ eit t -> const t ||| (flip op) t $ eit) )
+
+-- | Map a pair of applications (one over 'DirName', and the other over 'File') through a 'FileSystem'.
+mapFileSystem :: InApp DirName
+              -> InApp File
+              -> InApp FileSystem
+mapFileSystem f g = modDirCnt . fmap $ f *** mapFileSystem f g <|> g
+ System/FileSystem/Class.hs view
@@ -0,0 +1,62 @@+
+module System.FileSystem.Class
+ ( FSMonad (..)
+ , modifyFS
+ , apgetFS
+   ) where
+
+import System.FileSystem.Types
+--
+import Control.Applicative ((<$>))
+-- MTL Monad transformers
+import Control.Monad.State
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.RWS
+import Control.Monad.Error
+import Control.Monad.List
+import Control.Monad.Cont
+
+class (Functor m, Monad m) => FSMonad m where
+ getFS :: m FSState
+ putFS :: FSState -> m ()
+
+instance (Functor m, Monad m) => FSMonad (FST m) where
+ getFS = WrapFST get
+ putFS = WrapFST . put
+
+modifyFS :: FSMonad m => InApp FSState -> m ()
+modifyFS f = getFS >>= putFS . f
+
+apgetFS :: FSMonad m => (FSState -> a) -> m a
+apgetFS = (<$> getFS)
+
+--
+
+instance FSMonad m => FSMonad (ReaderT r m) where
+ getFS = lift getFS
+ putFS = lift . putFS
+
+instance (Monoid w, FSMonad m) => FSMonad (WriterT w m) where
+ getFS = lift getFS
+ putFS = lift . putFS
+
+instance FSMonad m => FSMonad (StateT s m) where
+ getFS = lift getFS
+ putFS = lift . putFS
+
+instance (Monoid w, FSMonad m) => FSMonad (RWST r w s m) where
+ getFS = lift getFS
+ putFS = lift . putFS
+
+instance (Error e, FSMonad m) => FSMonad (ErrorT e m) where
+ getFS = lift getFS
+ putFS = lift . putFS
+
+instance FSMonad m => FSMonad (ListT m) where
+ getFS = lift getFS
+ putFS = lift . putFS
+
+instance FSMonad m => FSMonad (ContT r m) where
+ getFS = lift getFS
+ putFS = lift . putFS
+ System/FileSystem/Computations.hs view
@@ -0,0 +1,69 @@+
+module System.FileSystem.Computations
+     ( putPath
+     , getFl
+     , getDirCnt
+     , checkFExist
+     , checkDExist
+     , newDir
+     , rmvPath
+     , rmvDir
+     , rmvFile
+     , rnmPath
+     , rnmDir
+     , rnmFile
+       ) where
+
+import Control.Monad.Identity (runIdentity)
+import Control.Monad.State (runStateT,modify,put)
+import Control.Arrow ( (***) , first , second )
+import Control.Applicative ( (<$>) , pure )
+import Data.Maybe (isJust)
+import Data.Either (partitionEithers)
+--
+import System.FileSystem.Types
+import System.FileSystem.Operators
+import System.FileSystem.Utils
+import System.FileSystem.Class
+
+putPath :: FSMonad m => Path -> m ()
+putPath = modifyFS . (<:)
+
+getFl :: (Functor m, FSMonad m) => FPath -> m (Maybe File)
+getFl = apgetFS . (?:)
+
+searchDirCnt :: DirPath -> FileSystem -> Maybe ([DirName],[FileName])
+searchDirCnt [] = Just . (fmap fst *** fmap getFN). partitionEithers . dirCnt
+searchDirCnt (x:xs) = maybe Nothing (searchDirCnt xs) . (x=:)
+
+getDirCnt :: (Functor m, FSMonad m) => DirPath -> m (Maybe ([DirName], [FileName]))
+getDirCnt = apgetFS . searchDirCnt
+
+checkFExist :: (Functor m, FSMonad m) => (DirPath, FileName) -> m Bool
+checkFExist (dp,fn) = maybe False (elem fn . snd) <$> getDirCnt dp
+
+checkDExist :: (Functor m, FSMonad m) => DirPath -> m Bool
+checkDExist = fmap isJust . getDirCnt
+
+newDir :: FSMonad m => DirPath -> m ()
+newDir = putPath . (`Path`Nothing)
+
+rmvPath :: FSMonad m => Path -> m ()
+rmvPath = modifyFS . (-:)
+
+rmvDir :: FSMonad m => DirPath -> m () 
+rmvDir = rmvPath . (`Path`Nothing)
+
+rmvFile :: FSMonad m => FPath -> m ()
+rmvFile = rmvPath . uncurry Path . second (Just . File emptyFD)
+
+rnmPath :: (Functor m, FSMonad m) => ([String], [String], Bool) -> m Bool
+rnmPath = bind (uncurry (>>) . (putFS *** return)) . apgetFS . (<-:)
+
+rnmDir :: (Functor m, FSMonad m) => (DirPath, DirPath) -> m Bool
+rnmDir = rnmPath . tup3 True
+
+rnmFile :: (Functor m, FSMonad m) => (FPath, FPath) -> m Bool
+rnmFile = let f = uncurry (++) . second pure
+          in  rnmPath . tup3 False . pairMap f
+
+ System/FileSystem/IO.hs view
@@ -0,0 +1,91 @@+
+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 "."
+
+ System/FileSystem/Instances.hs view
@@ -0,0 +1,76 @@+
+-- | Class instances for several types.
+module System.FileSystem.Instances
+  ( -- * @Monoid@ instances
+    -- ** @FileSystem@
+    -- | A 'FileSystem' is a 'Monoid' with respect
+    -- to the 'FileSystem' appending, being the 'emptyFileSystem'
+    -- the neutral element.
+
+    -- * @Binary@ instances
+    -- | 'Binary' instances given by this module:
+    --
+    -- * 'ClockTime' (this type comes from the "System.Time" module)
+    --
+    -- * 'FileData' (an internal type, you don't need to use it)
+    --
+    -- * 'File'
+    -- 
+    -- * 'FileSystem'
+    --
+    ) where
+
+import Data.Monoid (Monoid (..))
+import Control.Arrow (second)
+import Data.Binary (Binary (..) , Word8 , Get)
+import System.Time (ClockTime (..))
+--
+import System.FileSystem.Types
+import System.FileSystem.Operators
+
+-- Monoid instance
+
+instance Monoid FileSystem where
+ mempty = emptyFileSystem
+ mappend = curry $ uncurry (foldr (<<:)) . second dirCnt
+
+-- Binary instance
+
+instance Binary ClockTime where
+ put (TOD s m) = do put (0 :: Word8)
+                    put s
+                    put m
+ get = do t <- get :: Get Word8
+          case t of
+            0 -> do s <- get
+                    m <- get
+                    return (TOD s m)
+
+instance Binary FileData where
+ put (FD cnt lmt) = do put (0 :: Word8)
+                       put cnt
+                       put lmt
+ get = do t <- get :: Get Word8
+          case t of
+            0 -> do cnt <- get
+                    lmt <- get
+                    return (FD cnt lmt)
+
+instance Binary File where
+ put (File fd fn) = do put (0 :: Word8)
+                       put fd
+                       put fn
+ get = do t <- get :: Get Word8
+          case t of
+            0 -> do fd <- get
+                    fn <- get
+                    return (File fd fn)
+
+instance Binary FileSystem where
+ put (Directory xs) = do put (0 :: Word8)
+                         put xs
+ get = do t <- get :: Get Word8
+          case t of
+            0 -> do xs <- get
+                    return (Directory xs)
+
+ System/FileSystem/Operators.hs view
@@ -0,0 +1,155 @@+
+-- | Low-level operators.
+module System.FileSystem.Operators
+   ( (<:)
+   , (<<:)
+   , (?:)
+   , (=:)
+   , (-:)
+   , (<-:)
+     ) where
+
+import Data.Maybe (fromJust)
+import Control.Arrow (first,second)
+import System.FileSystem.Types
+
+
+{---------------------------------------------------
+-- For code readers:
+
+This is the not so pretty part of the code, but full
+of Haskell syntax (patterns, cases, conditionals, ...).
+
+In the other hand, the library works thanks to this module.
+So, if there is a bug, probably it comes from here.
+
+Before read these lines, you must to know the Path type
+and the FileSystem types, defined in the Types module.
+
+---------------------------------------------------}
+
+-- | Operator for addition of new files/directories.
+(<:) :: Path -> FileSystem -> FileSystem
+p <: fs =
+ case pathList p of
+  []     -> if isFilePath p then let rightFile = fromJust $ pathFile p
+                                     add :: InApp [FSE]
+                                     add [] = [ Right rightFile ]
+                                     add (e:es) =
+                                       case e of
+                                         Right f -> if getFN f ==
+                                                       getFN rightFile then Right rightFile : es
+                                                                       else e : add es
+                                         _ -> e : add es
+                                 in  modDirCnt add fs
+                            else fs
+  (x:xs) -> let pathTail = p { pathList = xs }
+                add :: InApp [FSE]
+                add [] = [ Left (x , pathTail <: emptyFileSystem) ]
+                add (e:es) =
+                  case e of
+                    Left (n,fs') -> if n == x then Left (n, pathTail <: fs') : es
+                                              else e : add es
+                    _ -> e : add es
+            in  modDirCnt add fs
+
+-- | Operator for addition of new file system elements ('FSE').
+(<<:) :: FSE -> FileSystem -> FileSystem
+(<<:) fse =
+ let add :: InApp [FSE]
+     add [] = [fse]
+     add (e:es) =
+            case e of
+              Right f' -> case fse of
+                            Right f -> if getFN f == getFN f' then fse : es
+                                                              else e : add es
+                            _ -> e : add es
+              Left (dn',fs') ->
+                          case fse of
+                            Left (dn,fs) -> let fs'' = foldr (<<:) fs' $ dirCnt fs
+                                            in if dn == dn' then Left (dn,fs'') : es
+                                                            else e : add es
+                            _ -> e : add es
+ in modDirCnt add
+
+-- | Operator for search a file.
+(?:) :: FPath -> FileSystem -> Maybe File
+(dp,fn) ?: fs =
+  case dp of
+   [] -> let search :: [FSE] -> Maybe File
+             search [] = Nothing
+             search (x:xs) = case x of
+                              Right f -> if fn == getFN f then Just f
+                                                          else search xs
+                              _ -> search xs
+         in  search $ dirCnt fs
+   (d:ds) -> let search :: [FSE] -> Maybe File
+                 search [] = Nothing
+                 search (x:xs) = case x of
+                                  Left (dn,fs') -> if d == dn then (ds,fn) ?: fs'
+                                                              else search xs
+                                  _ -> search xs
+             in  search $ dirCnt fs
+
+-- | Descension operator. Extract the file system of an immediate subdirectory.
+(=:) :: DirName -> FileSystem -> Maybe FileSystem
+dn =: fs =
+ case dirCnt fs of
+   [] -> Nothing
+   (x:xs) -> case x of
+               Left (dn',fs') -> if dn == dn' then Just fs'
+                                              else dn =: Directory xs
+               _ -> dn =: Directory xs
+
+-- | Substraction operator. Search and remove a file/directory from a file system.
+(-:) :: Path -> FileSystem -> FileSystem
+p -: fs =
+ case pathList p of
+   [] -> if isFilePath p then let remove :: InApp [FSE]
+                                  remove [] = []
+                                  remove (e:es) = case e of
+                                                   Right f -> if (getFN . fromJust . pathFile) p
+                                                              ==  getFN f then es
+                                                                          else e : remove es
+                                                   _ -> e : remove es
+                              in  modDirCnt remove fs
+                         else fs
+   (x:xs) -> let pathTail = p { pathList = xs }
+                 remove :: InApp [FSE]
+                 remove [] = []
+                 remove (e:es) = case e of
+                                  Left (dn,fs') -> if dn == x then Left (dn , pathTail -: fs') : es
+                                                              else e : remove es
+                                  _ -> e : remove es
+             in  case xs of
+                  [] -> if isFilePath p then modDirCnt remove fs
+                                        else let remove' :: InApp [FSE]
+                                                 remove' [] = []
+                                                 remove' (e:es) = case e of
+                                                                   Left (dn,fs') -> if dn == x then es
+                                                                                               else e : remove' es
+                                                                   _ -> e : remove' es
+                                             in  modDirCnt remove' fs
+                  _ -> modDirCnt remove fs
+
+-- | If the Bool argument is True, rename a directory, otherwise a file.
+(<-:*) :: (String,String,Bool) -> FileSystem -> (FileSystem,Bool)
+(<-:*) (s1,s2,b) =
+  let (&:) :: FSE -> ([FSE],Bool) -> ([FSE],Bool)
+      (&:) e = first (e:)
+      rename :: [FSE] -> ([FSE],Bool)
+      rename [] = ([],False)
+      rename (e:es) =
+        case e of
+          Left (dn,fs') -> if dn == s1 && b then ( Left (s2,fs') : es , True )
+                                            else e &: rename es
+          Right f -> if getFN f == s1 && not b then ( Right ( f { getFN = s2 } ) : es , True )
+                                               else e &: rename es
+  in first Directory . rename . dirCnt
+
+-- | Substitution operator. /Provisional implementation/.
+(<-:) :: ([String],[String],Bool) -> FileSystem -> (FileSystem,Bool)
+([s1],[s2],b) <-: fs = (s1,s2,b) <-:* fs
+( (d1:t1@(_:_)) , (d2:t2@(_:_)) , b ) <-: fs = if d1 == d2 then (t1,t2,b) <-: fs
+                                                           else (fs,False)
+_ <-: fs = (fs,False)
+ System/FileSystem/Types.hs view
@@ -0,0 +1,134 @@+
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module System.FileSystem.Types
+   ( -- * Synonyms
+     InApp
+   , DirName
+   , FileName
+   , FileCnt
+   , DirPath , toDirPath , fromDirPath
+   , FPath , toFPath , fromFPath
+     -- * File
+   , FileData (..)
+   , emptyFD
+   , File (..)
+     -- * File System
+   , FSE
+   , FileSystem (..)
+   , emptyFileSystem
+   , modDirCnt
+     -- * Path
+   , Path (..)
+   , isFilePath
+     -- * FileSystem monad
+   , FSState
+   , FST (..) , runFST
+   , FS , runFS
+     ) where
+
+import Data.ByteString (ByteString,empty)
+import Data.Maybe (isNothing)
+import System.Time (ClockTime (..))
+import Control.Monad.Identity (Identity (..))
+import Control.Monad.State (StateT,MonadIO,runStateT,MonadTrans)
+import System.FilePath (splitPath , splitFileName , joinPath , combine)
+import Control.Arrow ( first )
+
+-- | Internal Application: An application from somewhere over itself.
+type InApp a = a -> a
+
+-- | A name for a directory.
+type DirName = String
+
+-- | A name for a file.
+type FileName = String
+
+-- | The content of a file. Stored in a 'ByteString'.
+type FileCnt = ByteString
+
+-- | A list-based directory path.
+type DirPath = [DirName]
+
+-- | Translation between 'FilePath' and 'DirPath'.
+toDirPath :: FilePath -> DirPath
+toDirPath = splitPath
+
+-- | Translation between 'DirPath' and 'FilePath'.
+fromDirPath :: DirPath -> FilePath
+fromDirPath = joinPath
+
+-- | A file path, composed by the path of the directory which contains it,
+-- and its file name.
+type FPath = (DirPath,FileName)
+
+-- | Translation between 'FilePath' and 'FPath'.
+toFPath :: FilePath -> FPath
+toFPath = first splitPath . splitFileName
+
+-- | Translation between 'FPath' and 'FilePath'.
+fromFPath :: FPath -> FilePath
+fromFPath = uncurry combine . first fromDirPath
+
+-- | Information about the content of a file.
+data FileData = FD
+                 { getCnt :: FileCnt
+                 , getLmt :: ClockTime
+                   } deriving Eq
+
+-- | An empty file data.
+emptyFD :: FileData
+emptyFD = FD empty (TOD 0 0)
+
+-- | A complete file.
+data File = File 
+              { getFD :: FileData
+              , getFN :: FileName
+                } deriving Eq
+
+instance Show File where
+ show (File _ fn) = "FILE[" ++ fn ++ "]"
+
+-- | File System Element: Each one of the elements in a 'FileSystem'.
+type FSE = Either (DirName,FileSystem) File
+
+-- | The file system structure. It stores a directory with files and subdirectories.
+newtype FileSystem = Directory { dirCnt :: [FSE] } deriving Show
+
+-- | An empty file system.
+emptyFileSystem :: FileSystem
+emptyFileSystem = Directory []
+
+-- | Lift a function over a list of 'FSE' (File System Elements)
+-- to a function over 'FileSystem'.
+modDirCnt :: InApp [FSE] -> InApp FileSystem
+modDirCnt f fs = fs { dirCnt = f $ dirCnt fs }
+
+-- | A path to a possible 'File'.
+data Path = Path
+              { pathList :: DirPath
+              , pathFile :: Maybe File
+                }
+
+-- | Check if a 'Path' contents a 'File'.
+isFilePath :: Path -> Bool
+isFilePath = not . isNothing . pathFile
+
+-- | The state of file system computations.
+--
+-- Currently, a 'FileSystem' structure.
+type FSState = FileSystem
+
+-- | Monadic transformer which adds a 'FSState' environment.
+newtype FST m a = WrapFST { unwrapFST :: StateT FSState m a } deriving (Functor, Monad, MonadIO, MonadTrans)
+
+-- | Run an 'FST' computation, given an initial state.
+runFST :: Monad m => FST m a -> FSState -> m (a,FSState)
+runFST = runStateT . unwrapFST
+
+-- | Application of the 'FST' monad transformer to the 'Identity' monad.
+type FS = FST Identity
+
+-- | Just a composition of 'runIdentity' and 'runFST'.
+runFS :: FS a -> FSState -> (a,FSState)
+runFS c = runIdentity . runFST c
+ System/FileSystem/Utils.hs view
@@ -0,0 +1,74 @@+
+module System.FileSystem.Utils
+   ( bind
+   , comb
+   , tup3
+   , apget
+   , options
+   , (<|>)
+   , ($$)
+   , pairMap
+     ) where
+
+import Control.Applicative (Applicative,liftA2,(<$>))
+import Control.Arrow ( (&&&) , (|||) , (***) , arr
+                     , Arrow , (<<<) , ArrowChoice )
+import Control.Monad.State (MonadState,get,zipWithM)
+import Data.Maybe (catMaybes,listToMaybe)
+import Control.Monad (join)
+
+-- | The '=<<' operator as a function.
+bind :: Monad m => (a -> m b) -> m a -> m b
+bind = (=<<)
+
+-- | The resulting function of 'comb' is such that it applies two (possible) different functions
+-- to a single element, and combine both results with the given operator, inside of an 'Applicative' container.
+comb :: Applicative f
+     => (b -> c -> d) -- ^ The operator.
+     -> (a -> f b)    -- ^ The first function.
+     -> (a -> f c)    -- ^ The second function.
+     -> (a -> f d)    -- ^ The resulting function.
+comb op f g = uncurry (liftA2 op) . (f &&& g)
+
+-- | Given a list @xs@ of pairs (monadic condition, monadic function),
+-- 'options' @xs@ applies to its argument the first function that
+-- satisfy the condition, and returns 'Nothing' if no condition was satisfied.
+options :: (Functor m, Monad m)
+        => [ ( a -> m Bool , a -> m b ) ]
+        -> (a -> m (Maybe b))
+options = flip $ \a ->
+          fmap (listToMaybe . catMaybes)
+        . mapM (uncurry $
+                 \c f -> do b <- c a
+                            if b then Just <$> f a
+                                 else return Nothing)
+
+-- | This function just adds a third component to a two-components tuple.
+tup3 :: c -> (a,b) -> (a,b,c)
+tup3 c (a,b) = (a,b,c)
+
+-- | Apply a function over the state, and return its result.
+apget :: (Functor m, MonadState s m) => (s -> a) -> m a
+apget = (<$> get)
+
+infixr 1 <|>
+-- | An 'ArrowChoice' operator.
+-- Given an arrow @a ~> b@ and an arrow @c ~> d@:
+-- 
+-- > a ~> b <|> c ~> d
+-- >  = Either a c ~> Either b d    { (a ~> b) lifted with Left for Left values.
+-- >                          with -{          
+-- >                                { (c ~> d) lifted with Right for Right values.
+--
+-- /Its name comes from the union of/ '<$>' /and/ '|||'.
+(<|>) :: ArrowChoice f => f a b -> f c d -> f (Either a c) (Either b d)
+f <|> g = (arr Left <<< f) ||| (arr Right <<< g)
+
+-- | Transforms a simple arrow to the same arrow applied to the two components of a pair.
+pairMap :: Arrow f => f a b -> f (a,a) (b,b)
+pairMap f = f *** f
+
+-- | This operator is similar to '$', but the argument is used twice.
+($$) :: (a -> a -> b) -> a -> b
+f $$ x = f x x
+
+ license view
@@ -0,0 +1,30 @@+Copyright (c)2010, Daniel Díaz
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Daniel Díaz nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.