{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Halfs.Utils
--
-- Maintainer  :  Isaac Jones <ijones@galois.com>
-- Stability   :  alpha
-- Portability :  GHC
--
-- Explanation: Implements some useful routines and stores some
-- interesting constants.

module Halfs.Utils
       ( module Halfs.Utils
       , module System.RawDevice.Base
       ) where

import Binary (Binary, put_, get)

-- base
import Numeric(showHex)
import Data.Char (toUpper)
import Control.Monad(when)
import Control.Monad.Error(throwError, MonadError)
import Data.Array (Array)
import Data.Array.MArray
import System.Directory (removeFile, doesFileExist)
import System.IO.Error(userError)
import System.RawDevice.Base
import Data.Integral

type INPointers = Array Int DiskAddress


-- |Like fromJust, but spits out the given error on failure.  This is
-- for situations which should not happen
fromJustErr :: String -- ^Error to spew before failing to continue
            -> Maybe a
            -> a
fromJustErr s Nothing  = error s
fromJustErr _ (Just a) = a

-- |Get a block of memory that's the right size for a block.
-- NOTE: leak

getMemoryBlock :: IO (BufferBlockHandle s)
getMemoryBlock = newBufferBlockHandle

myShowHex :: (Integral i) => i -> String
myShowHex n = "0x" ++ map toUpper (Numeric.showHex n [])

rootInodeNum :: INInt
rootInodeNum = 0

-- See notes about the block map in TheBlockMap.hs.  Block map
-- filesize never changes.
blockMapInodeNum :: INInt
blockMapInodeNum = 16

inodeMapInodeNum :: INInt
inodeMapInodeNum = 17

rootDirInodeNum :: INInt
rootDirInodeNum = 18

firstFreeInodeNum :: INInt
firstFreeInodeNum = rootDirInodeNum + 1

blockPointersPerInode :: Int
blockPointersPerInode = 16

blockPointersPerIndirectBlock :: Int
blockPointersPerIndirectBlock = bytesPerBlock `div` bytesPerBlockPointer

bytesPerBlockPointer :: Int
bytesPerBlockPointer = 4

bytesPerInode :: Int
bytesPerInode = 256

inodesPerBlock :: Int
inodesPerBlock   = bytesPerBlock `div` bytesPerInode

rootInodeMagicNum :: INInt
rootInodeMagicNum  = 0x2395458

otherInodeMagicNum :: INInt
otherInodeMagicNum = 0x4814819

inodePadding :: Int
inodePadding = 8 -- FIX: compute this someplace.

data FileType = File    -- ^1
              | Dir     -- ^2
              | SymLink -- ^3
      deriving (Show, Eq)

modeFile :: Int
modeFile = 1

modeDir :: Int
modeDir = 2

modeSymLink :: Int
modeSymLink = 3

mRemoveFile :: FilePath -> IO ()
mRemoveFile p = do
  b <- doesFileExist p
  when b (removeFile p)

secondToMicroSecond :: Integer -> Integer
secondToMicroSecond n = n * 1000000

instance Enum FileType where
    toEnum x | x == modeFile = File
             | x == modeDir  = Dir
             | x == modeSymLink = SymLink
             | otherwise
                   = error $ "internal fromEnum for FileTypes; unknown: " ++ (show x)
    fromEnum File    = modeFile
    fromEnum Dir     = modeDir
    fromEnum SymLink = modeSymLink

instance Binary FileType where
    put_ h f = put_ h (intToINInt (fromEnum f))
    get h   = do x <- get h
                 return $ toEnum (inIntToInt x)

-- I think this instance is there in GHC 6.4
{-
instance Error String where
  noMsg    = ""
  strMsg s = s
-}
unimplementedM :: (MonadError IOError m) => String -> m a
unimplementedM s = throwError $ userError $ "Unimplemented: " ++ s

unimplemented :: String -> a
unimplemented s = error $ "Unimplemented: " ++ s

-- Mutate an array derived from the original array by applying a
-- function to each of the elements.

mutateMapArray :: (MArray a e m, Ix i) =>
                  (e -> e) -- function to new values
                  -> a i e
                  -> m ()
mutateMapArray fun ar = do
  entries <- getAssocs ar
  mapM_ updateElem (map (\ (i,_) -> i) entries)

 where updateElem i = do
         e <- readArray ar i
         writeArray ar i (fun e)