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

module Hydrogen.Prelude.System (
    module Hydrogen.Prelude.IO
  , module System.CPUTime
  , module System.Directory
  , module System.Environment
  , module System.Exit
  , module System.FilePath
  , module System.Info
  , module System.Process
  , module System.Random
  , findFilesRecursively
  , findFilesRecursivelyWithContext
  , escapeFileName
  , unescapeFileName
) where

import Hydrogen.Prelude.IO

import "base" System.CPUTime
import "directory" System.Directory
import "base" System.Environment
import "base" System.Exit
import "filepath" System.FilePath
import "base" System.Info
import "process" System.Process
import "random" System.Random

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) /= '.'))


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


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