{-# LANGUAGE RankNTypes, ImplicitParams #-} module System.Simple.File ( -- * Exported modules module System.FilePath,module SimpleH, -- * The File interface File(..),DirEntry(..), getFile, workingDirectory, Location(..), pathTo, -- ** Status modTime, -- ** Useful Lenses file,contents,child,descendant, named,withExtension, fileName,entry,text,fileData, ) where import SimpleH import Data.Containers import Control.Reactive.Time import System.Directory import System.FilePath ((),FilePath) import System.IO.Unsafe import System.Posix.Process (getProcessID) import Data.Time.Clock.POSIX import qualified Data.ByteString as BS import qualified Prelude as P data File = File (Maybe String) (Maybe BS.ByteString) | Directory (Map String File) instance Show File where show (File _ _) = "File" show (Directory d) = show d instance Semigroup File where Directory d + Directory d' = Directory (d+d') a + _ = a data DirEntry = DirEntry FilePath File deriving Show instance Lens1 String String DirEntry DirEntry where _1 = from _DirEntry._1 instance Lens2 File File DirEntry DirEntry where _2 = from _DirEntry._2 fileName :: Lens' DirEntry String fileName = _1 entry :: Lens' DirEntry File entry = _2 il :: IO a -> IO a il = unsafeInterleaveIO getFile :: FilePath -> IO File getFile path = do d <- doesDirectoryExist path if d then do files <- unsafeInterleaveIO (getDirectoryContents path) return $ Directory $ fromList [ (name,unsafePerformIO (getFile (pathname))) | name <- files, not (name`elem`[".",".."])] else File<$>il (tryMay $ traverse (yb _thunk) =<< P.readFile path) <*>il (tryMay $ BS.readFile path) _File :: ((Maybe String,Maybe BS.ByteString):+:Map String File) :<->: File _File = iso f' f where f (File x y) = Left (x,y) f (Directory d) = Right d f' = uncurry File <|> Directory _DirEntry :: (FilePath,File) :<->: DirEntry _DirEntry = iso (uncurry DirEntry) (\ ~(DirEntry p f) -> (p,f)) file :: Traversal' File (Maybe String,Maybe BS.ByteString) file = from _File._l contents :: Traversal' File (Map String File) contents = from _File._r child :: Traversal' File File child = contents.traverse descendant :: Fold' File File descendant = id .+ child.descendant text :: Traversal' File String text = file._1._r fileData :: Traversal' File ByteString fileData = file._2._r named :: (String -> Bool) -> Traversal' DirEntry DirEntry named p = sat (\(DirEntry name _) -> p name) withExtension :: String -> Traversal' DirEntry DirEntry withExtension e = named (\s -> drop (length s-(length e+1)) s==('.':e)) -- |The working directory, as a DirEntry workingDirectory :: IO File workingDirectory = getFile =<< getCurrentDirectory modTime :: FilePath -> IO Seconds modTime p = getModificationTime p <&> realToFrac . utcTimeToPOSIXSeconds data Location = Self | Owner | System | Here pathTo :: ( ?progName :: FilePath ) => Location -> FilePath pathTo Self = (getTemporaryDirectory^._thunk) ?progName + "-" + show (getProcessID^._thunk) pathTo Owner = getHomeDirectory^._thunk "." + ?progName pathTo System = "/usr/share" ?progName pathTo Here = getCurrentDirectory^._thunk