{-# 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 = canonicalizePath dir >>= find'
      where
        find' thisDirectory
          | 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)
      | 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

