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