module SimpleH.File (
  -- * Exported modules
  module System.FilePath,module SimpleH,

  -- * The File interface
  File(..),
  getFile,showFile,

  _file,_directory,

  getCurrentDirectory
  ) where

import SimpleH
import System.Directory
import System.FilePath ((</>))
import System.IO.Unsafe
import qualified Data.ByteString as BS

data File = File (Maybe String) (Maybe BS.ByteString)
          | Directory [(String,File)]
          deriving Show

il :: IO a -> IO a
il = unsafeInterleaveIO

getFile :: FilePath -> IO File
getFile path = il $ do
  d <- doesDirectoryExist path
  if d then do
    files <- unsafeInterleaveIO (getDirectoryContents path)
    return $ Directory [(name,unsafePerformIO (getFile (path</>name)))
                       | name <- files, not (name`elem`[".",".."])]
    else File<$>il (tryMay $ traverse (at' _thunk) =<< readFile path)
         <*>il (tryMay $ BS.readFile path)

showFile :: File -> String
showFile = showFile' 0
  where showFile' n (Directory fs) = "/"+foldMap (
          \(nm,f) -> "\n"+replicate n ' '+nm+showFile' (n+2) f) fs
        showFile' _ (File (Just c) _) = ": "+show (takeWhile (/='\n') c)
        showFile' _ (File _ (Just _)) = ": <bin>"
        showFile' _ _ = ": <not-readable>"

_File :: ((Maybe String,Maybe BS.ByteString):+:[(String,File)]) :<->: File
_File = iso f' f
  where f (File x y) = Left (x,y)
        f (Directory d) = Right d
        f' = uncurry File <|> Directory
_file :: Traversal' File (Maybe String,Maybe BS.ByteString)
_file = from _File._l
_directory :: Traversal' File [(String,File)]
_directory = from _File._r