module Extra.Misc
    (-- * List functions
    -- * String functions
      columns
    , justify
    -- * Tuple functions
    , mapSnd
    -- * FilePath functions
    , parentPath
    , canon
    -- * Map and Set functions
    , listMap
    , listDiff
    -- * Either functions
    -- * System.IO functions
    --ePut,
    --ePutList,
    -- * System.Posix
    , checkSuperUser
    -- removeRecursiveSafely,
    , md5sum
    , sameInode
    , sameMd5sum
    , tarDir
    -- * Processes
    -- , Extra.Misc.processOutput
    -- , processOutput2
    , splitOutput
    -- ByteString
    , cd
    -- Debugging
    , read'
    ) where

import		 Control.Exception
import qualified Data.ByteString.Lazy.Char8 as B
import		 Data.List
import qualified Data.Map as Map
import		 Data.Maybe
import qualified Data.Set as Set
import		 Extra.List
import		 System.FilePath
import		 System.Unix.Process
import		 System.Directory
import		 System.Posix.Files
import		 System.Posix.User (getEffectiveUserID)
import		 Text.Regex

mapSnd :: (b -> c) -> (a, b) -> (a, c)
mapSnd f (a, b) = (a, f b)

-- Control file stuff

{-
mergeControls :: [Control] -> Control
mergeControls (Control p1 : Control p2 : etc) = mergeControls (Control (p1 ++ p2) : etc)
mergeControls [Control p1]  = Control p1
mergeControls [] = Control []    

fieldValue :: String -> Paragraph -> Maybe String
fieldValue fieldName paragraph =
    maybe Nothing value (lookupP fieldName paragraph)
    where value (Field (_, value)) = (Just . stripWS) value

hasField :: String -> String -> Paragraph -> Bool
hasField field value paragraph =
    maybe False (== value) (fieldValue field paragraph)
-}

-- |Pad strings so the columns line up. The argument and return value
-- elements are the rows of a table.  Do not pad the rightmost column.
columns :: [[String]] -> [[String]]
columns rows =
    map (map pad . zip (widths ++ [0])) rows
    where
      widths = map (fromJust . listMax) . transpose . map (map length . init) $ rows
      listMax l = foldl (\ a b -> Just . maybe b (max b) $ a) Nothing l
      pad (width, field) = field ++ replicate (max 0 (width - length field)) ' '

-- |Group words into lines of length n or less.
justify :: String -> Int -> [[String]]
justify s n =
    foldr doWord [[]] (words s)
    where doWord w [] = [[w]]
	  doWord w (ws : etc) = 
	      if length (concat (intersperse " " (w:ws))) <= n then
		 (w : ws) : etc else
		 [w] : ws : etc

-- |dirname
parentPath :: FilePath -> FilePath
parentPath path = fst (splitFileName path)

{-
baseName :: FilePath -> String
baseName path = snd (splitFileName path)
-}

-- |Turn a list of (k, a) pairs into a map from k -> [a].  The order of the elements in
-- the a list is preserved.
listMap :: (Ord k) => [(k, a)] -> Map.Map k [a]
listMap pairs =
    foldl insertPair Map.empty (reverse pairs)
    where insertPair m (k,a) = Map.insert k (a : (Map.findWithDefault [] k m)) m

-- Return the difference of two lists.  Order is not preserved.
listDiff :: Ord a => [a] -> [a] -> [a]
listDiff a b = Set.toList (Set.difference (Set.fromList a) (Set.fromList b))

-- | Weak attempt at canonicalizing a file path.
canon :: FilePath -> FilePath
canon path =
    let re = mkRegex "/" in
    let names = splitRegex re path in
    concat (intersperse "/" (merge names))
    where
      merge (".." : xs) = ".." : (merge xs)
      merge ("." : xs) = "." : (merge xs)
      merge (_ : ".." : xs) = (merge xs)
      merge (x : "." : xs) = (merge (x : xs))
      merge (x : xs) = x : merge xs
      merge [] = []

-- | Run md5sum on a file and return the resulting checksum as text.
md5sum :: FilePath -> IO (Either String String)
md5sum path =
    do output <- lazyCommand cmd B.empty
       let result =
               case exitCodeOnly output of
                 ExitFailure n -> Left ("Error " ++ show n ++ " running '" ++ cmd ++ "'")
                 ExitSuccess ->
                     case listToMaybe . words . B.unpack . stdoutOnly $ output of
                       Nothing -> Left $ "Error in output of '" ++ cmd ++ "'"
                       Just checksum -> Right checksum
       return result
    where
      cmd = "md5sum " ++ path

-- | Predicate to decide if two files have the same inode.
sameInode :: FilePath -> FilePath -> IO Bool
sameInode a b =
    do
      aStatus <- getFileStatus a
      bStatus <- getFileStatus b
      return (deviceID aStatus == deviceID bStatus && fileID aStatus == fileID bStatus)

-- | Predicate to decide if two files have the same md5 checksum.
sameMd5sum :: FilePath -> FilePath -> IO Bool
sameMd5sum a b =
    do
      asum <- md5sum a
      bsum <- md5sum b
      return (asum == bsum)

{-
-- | Backwards compatibility functions.
processOutput :: String -> IO (Either Int String)
processOutput command =
    do
      output <- lazyCommand command B.empty
      case exitCodeOnly output of
        ExitSuccess -> return . Right . B.unpack . stdoutOnly $ output
        ExitFailure n -> return . Left $ n
        _ -> error "My.processOutput: Internal error 13"

processOutput2 :: String -> IO (String, ExitCode)
processOutput2 command =
    do
      output <- lazyCommand command B.empty
      return ((B.unpack . stdoutOnly $ output), exitCodeOnly output)
-}

splitOutput :: [Output] -> (B.ByteString, B.ByteString, ExitCode)
splitOutput output = (stdoutOnly output, stderrOnly output, exitCodeOnly output)

-- |A version of read with a more helpful error message.
read' s =
    case reads s of
      [] -> error $ "read - no parse: " ++ show s
      ((x, _s) : _) -> x

{-
type DryRunFn = IO () -> (Bool, String) -> IO ()

(-?-) :: DryRunFn
-- ^ If this is a dry run (dryRun params is True) do *not* evaluate f,
-- but instead print a message.
(-?-) f (dryRun, "") = if dryRun then return () else f
(-?-) f (dryRun, msg) =
    do
      hPutStrLn stderr msg
      if dryRun then return () else f
infixr 9 -?-
-}

{-
(+/+) :: FilePath -> FilePath -> FilePath
(+/+) path1 "" = path1
(+/+) "" path2 = path2
(+/+) path1 path2 =
    case (last path1, head path2) of
      ('/', '/') -> path1 +/+ (tail path2)
      (_, '/') -> path1 ++ path2
      ('/', _) -> path1 ++ path2
      (_, _) -> path1 ++ "/" ++ path2
-}

{-
-------------- From MissingH --------------

-- | Split the path into directory and file name
--
-- Examples:
--
-- \[Posix\]
--
-- > splitFileName "/"            == ("/",    ".")
-- > splitFileName "/foo/bar.ext" == ("/foo", "bar.ext")
-- > splitFileName "bar.ext"      == (".",    "bar.ext")
-- > splitFileName "/foo/."       == ("/foo", ".")
-- > splitFileName "/foo/.."      == ("/foo", "..")
--
-- \[Windows\]
--
-- > splitFileName "\\"               == ("\\",      "")
-- > splitFileName "c:\\foo\\bar.ext" == ("c:\\foo", "bar.ext")
-- > splitFileName "bar.ext"          == (".",       "bar.ext")
-- > splitFileName "c:\\foo\\."       == ("c:\\foo", ".")
-- > splitFileName "c:\\foo\\.."      == ("c:\\foo", "..")
--
-- The first case in the Windows examples returns an empty file name.
-- This is a special case because the \"\\\\\" path doesn\'t refer to
-- an object (file or directory) which resides within a directory.

splitFileName :: FilePath -> (String, String)
splitFileName p = (reverse path1, reverse fname1)
  where
    (fname,path) = break isPathSeparator (reverse p)
    path1 = case path of
      "" -> "."
      _  -> case dropWhile isPathSeparator path of
	"" -> [pathSeparator]
	p  -> p
    fname1 = case fname of
      "" -> "."
      _  -> fname

-- | Checks whether the character is a valid path separator for the host
-- platform. The valid character is a 'pathSeparator' but since the Windows
-- operating system also accepts a slash (\"\/\") since DOS 2, the function
-- checks for it on this platform, too.
isPathSeparator :: Char -> Bool
isPathSeparator ch =
  ch == '/'

-- | Provides a platform-specific character used to separate directory levels in
-- a path string that reflects a hierarchical file system organization. The
-- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash
-- (@\"\\\"@) on the Windows operating system.
pathSeparator :: Char
pathSeparator = '/'
-}


checkSuperUser :: IO Bool
checkSuperUser = getEffectiveUserID >>= return . (== 0)

-- | Given a tarball, return the name of the top directory.
tarDir :: FilePath -> IO (Maybe String)
tarDir path =
    lazyCommand cmd B.empty >>= \ output ->
    case exitCodeOnly output of
      ExitSuccess -> return . dir . lines . B.unpack . stdoutOnly $ output
      _ -> return Nothing
    where
      cmd = "tar tfz '" ++ path ++ "'"
      dir [] = Nothing
      dir (file : _) = case wordsBy (== '/') file of
                         [] -> Nothing
                         ("" : _) -> Nothing
                         (s : _) -> Just s

cd :: FilePath -> IO a -> IO a
cd name m = 
    bracket 
        (do cwd <- getCurrentDirectory
            setCurrentDirectory name
            return cwd)
        (\oldwd -> do setCurrentDirectory oldwd)
        (const m)