module System.Simple.File (
module System.FilePath,module SimpleH,
File(..),DirEntry(..),
getFile,
workingDirectory,
Location(..),
pathTo,
modTime,
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 (path</>name)))
| 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))
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