{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Hydrogen.Util.Files where

import Hydrogen.Prelude.System
import qualified Data.Set as Set


findFilesRecursively :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
findFilesRecursively f dir =
    map fst <$> findFilesRecursivelyWithContext (\c _ _ -> return c) f () dir


findFilesRecursivelyWithContext
    :: forall c.
       (c -> FilePath -> [FilePath] -> IO c)  -- ^ update function for current context
    -> (FilePath -> IO Bool)                  -- ^ predicate to filter files
    -> c                                      -- ^ current context
    -> FilePath -> IO [(FilePath, c)]
findFilesRecursivelyWithContext updater predicate context dir = do

    cwd <- getCurrentDirectory
    snd <$> find Set.empty context (cwd </> dir)

  where
    find :: Set FilePath -> c -> FilePath -> IO (Set FilePath, [(FilePath, c)])
    find visited context dir = do

      thisDirectory <- canonicalizePath dir
      if | Set.member thisDirectory visited -> return (Set.empty, [])
         | otherwise -> do

            allFiles <- map (dir </>) <$> getDirectoryContents dir
            theFiles <- filterFiles allFiles
            theDirs  <- filterM isDir allFiles
            context' <- updater context dir theFiles

            let visited' = Set.insert thisDirectory visited
                f (visited, files) dir = do
                    (visited', files') <- find visited context' dir
                    return (visited', files' : files)

            (visited'', files') <- foldM f (visited', []) theDirs
            
            return (visited'', concat (zip theFiles (repeat context') : files'))

    filterFiles = filterM (\x -> liftM2 (&&) (doesFileExist x) (predicate x))
    isDir x = liftM2 (&&) (doesDirectoryExist x) (return (head (takeFileName x) /= '.'))


escape :: String -> String
escape s = case s of
    ('/' : xs)
        -> '_' : escape xs
    (x : xs) ->
      if | isSafeChar x -> x : escape xs
         | ord x <= 255 -> '$' : printf "%02X" (ord x) ++ escape xs
         | otherwise    -> "$$" ++ printf "%04X" (ord x) ++ escape xs
    [] -> []
  where
    isSafeChar x = isAscii x && isAlphaNum x || x `elem` ".-"


unescape :: String -> Maybe String
unescape s = case s of
    ('$' : '$' : a : b : c : d : xs)
        -> (chr <$> hexnum (a : b : c : [d])) `cons` unescape xs
    ('$' : a : b : xs)
        -> (chr <$> hexnum (a : [b])) `cons` unescape xs
    ('_' : xs)
        -> pure '/' `cons` unescape xs
    (x : xs)
        -> pure x `cons` unescape xs
    [] -> return []
  where
    cons = liftA2 (:)
    hexnum = fmap fst . listToMaybe . readHex