{-# LANGUAGE PatternSignatures #-}
module Halfs.FileHandle (fhRead, fhSize, fhRewind, fileHandle, fileHandle',
                         fhCloseRead, fhCloseWrite, fhSeek, fhInode, fhOpenWrite,
                         fhOpenTruncate, fhWrite, getDirectoryAtPath,
                         allocateInodeWrite,
                         getSomethingAtPath, FileMode(..), FileHandle(..),
                         unitTests, readFileFromInode, newDirectory, unlink,
                         getInodeAtPath, openFileAtPath, doesPathExist)
    where

import Halfs.Inode (Inode(..), InodeMetadata(..), inodeBumpSize,
                    goodInodeMagic, newInode, dupInode, updatePointers)
import Data.Integral ( INLong, INInt, fromIntegral'',
                       intToINInt, intToINLong, inIntToINLong)
import Halfs.Utils (BlockNumber, bytesPerBlock, FileType(..),
                    unimplemented, rootInodeMagicNum)
import Halfs.BasicIO (getDiskAddrOfBlockWrite,
                      readPartOfBlock, writePartOfBlock,
                      readDirectoryBin, getInodeRead, getInodeWrite,
                      freeInodeData, fsRootFreeInode)
import Binary (BinHandle)
import Halfs.BinaryMonad (openBinMemRW, sizeBinMemRW, resetBinRW)
import {-# SOURCE #-} Halfs.Blocks(getDiskAddrOfBlockRead)
import Halfs.FSRoot (FSRoot(..), fsRootRootDirInode, fsRootUpdateInodeCache,
                     fsRootUpdateDirectoryCache, allocateInode)

import Halfs.TestFramework (Test, test, (~=?), (~:), UnitTests, hunitToUnitTest)
import qualified Halfs.FSState (get, put)
import Halfs.TheInodeMap(freeInode)
import Halfs.FSState (doesNotExistEx, FSWrite, FSRead,
                      modify, eofEx, decLinksForInode,
                      readToWrite, unsafeReadGet, unsafeModifyFSRead,
                      catchError, updateInodeCacheWrite)
import Halfs.TheBlockMap (freeBlock)

import {-# SOURCE #-} Halfs.Directory(Directory(..),
                                      getDirectoryFromCache,
                                      removeChild, getChildWithName)

-- Base
import qualified Data.Map as Map
import Data.Array(assocs)
import Data.List(sort)
import Control.Exception(assert)
import Control.Monad(foldM, unless, when)
import Control.Monad.Error(throwError)
import Halfs.CompatFilePath (splitFileName)
import System.IO.Error (isDoesNotExistError)
-- ------------------------------------------------------------
-- * FileHandle stuff
-- ------------------------------------------------------------

data FileMode = ReadMode | WriteMode | AppendMode deriving (Eq, Show)

-- |This is _not_ an opaque type.  Anyone can change the mode of
-- elements, reguardless of whether they're in the FSRead or FSWrite
-- monads.  The mode here is _not_ enforcing.  Maybe eventually will
-- be opaque. FIX.

data FileHandle
    = FileHandle {fhInodeNum :: INInt
                 ,fhSeekPos :: INLong
                 ,fhMode    :: FileMode
                 } deriving (Show, Eq) -- FIX: eq instance should probably be the inode number?

fhSize :: FileHandle -> FSRead INLong
fhSize fh = do
  inode <- fhInode fh
  return $ num_bytes $ metaData inode

fhInode :: FileHandle -> FSRead Inode
fhInode FileHandle{fhInodeNum=n}
    = getInodeRead n Nothing

-- |A "smart" constructor for FileHandle.  Does not truncate file in
-- write mode or anything like that.
fileHandle :: INInt -> FileMode -> FileHandle
fileHandle iNum f = fileHandle' iNum 0 f

-- |Another smart construcor.
fileHandle' :: INInt -> INLong -> FileMode -> FileHandle
fileHandle' iNum s f = FileHandle iNum s f

-- |open for write.
fhOpenWrite :: INInt -> FSWrite FileHandle
fhOpenWrite inodeNum = do
    return $ FileHandle inodeNum 0 WriteMode

-- |Opens the file in write mode and frees all blocks in the file.
-- Reuses the inode.
fhOpenTruncate :: INInt -> FSWrite FileHandle
fhOpenTruncate inodeNum0 = do
  oldInode@
   Inode{metaData=InodeMetadata{inode_num=inodeNum
                               ,mode=theMode
                               ,hard_links=oldHardLinks
                               ,magic1=theMagic}} <- getInodeWrite inodeNum0 Nothing
  let newI' = newInode inodeNum theMode
  let newI = newI'{metaData=(metaData newI'){magic1 = theMagic
                                            ,hard_links=oldHardLinks}}
  when (theMagic == rootInodeMagicNum) (error "overwriting root inode.")
  modify (\fsroot -> fsRootUpdateInodeCache fsroot newI)
  freeInodeData oldInode
  return $ fileHandle inodeNum WriteMode

-- |Close this handle. Does nothing for now.
fhCloseRead :: FileHandle -> FSRead ()
fhCloseRead _ = return ()

-- |Close this handle. Does nothing for now.
fhCloseWrite :: FileHandle -> FSWrite ()
fhCloseWrite _ = return ()

fhRewind :: FileHandle -> FileHandle
fhRewind fh = fh{fhSeekPos=0}

fhSeek :: FileHandle -> INLong -> FileHandle
fhSeek fh n = fh{fhSeekPos=n}

-- ------------------------------------------------------------
-- * Read
-- ------------------------------------------------------------

-- |Must not touch the block map in fhRead, since it may not be
-- well-formed yet.
fhRead :: FileHandle
       -> BinHandle  -- ^Buffer to read into
       -> INInt      -- ^Offset into above buffer
       -> INInt      -- ^How many to read
       -> FSRead (FileHandle, INInt)    -- ^Number actually read, nothing if eof
fhRead inFh _buffer _offset _len = do
  buffSize <- sizeBinMemRW _buffer
  (newLen::INInt)
      <- fhSize inFh >>= fhRead' inFh _buffer _offset _len (intToINInt buffSize)
  return $ (inFh{fhSeekPos=(fhSeekPos inFh) + inIntToINLong newLen}, newLen)

  where

  fhRead' :: FileHandle
          -> BinHandle        -- ^Buffer to read into
          -> INInt            -- ^Offset into above buffer
          -> INInt            -- ^How many to read
          -> INInt            -- Buffer size
          -> INLong           -- Size of file (from fhSize)
          -> FSRead INInt -- ^Number actually read, nothing if eof
  fhRead' fh@FileHandle{fhSeekPos=filePos} buffer offset len buffSize fileSize
  -- First two cases handle bad length requests.
      | offset + len > buffSize
          =  fhRead' fh buffer offset (buffSize - offset) buffSize fileSize
      | filePos + (inIntToINLong len) > fileSize
            -- safe conversion, since len is INInt
          = let (newLen::INInt) = fromIntegral'' $ fileSize - filePos
                in if newLen <= 0
                   then throwError $ eofEx ""
                   else fhSize fh >>= fhRead' fh buffer
                                      (assert (newLen < len) offset)
                                      newLen buffSize
      | otherwise = do sums <- mapM (\ (startPos::INLong, len', soFar) -> do
                           inode <- fhInode fh
                           readBlock inode
                                     -- following fromIntegral'' is kinda safe, due to mod.
                                     (fromIntegral'' (startPos `div` intToINLong bytesPerBlock))
                                     (fromIntegral'' (startPos `mod` intToINLong bytesPerBlock))
                                     len' buffer (offset + soFar))
                             (seekPositions filePos len)
                       return (sum sums) -- the amount actually read


-- |Read a number of bytes from the given file.
readBlock :: Inode    -- The file to read from
          -> BlockNumber    -- Block number of the file to read
          -> INInt    -- Offset in the above block
          -> INInt    -- number of bytes to read
          -> BinHandle -- Array to read the block into
          -> INInt    -- buffer offset; where to read this block into
          -> FSRead INInt -- Number of bytes read
readBlock inode blockNum blockOffset numBytes buffer buffOffset
    = do da <- getDiskAddrOfBlockRead inode blockNum
         readPartOfBlock da blockOffset buffer buffOffset numBytes

-- ------------------------------------------------------------
-- * Write
-- ------------------------------------------------------------

fhWrite :: FileHandle
        -> BinHandle  -- ^Buffer to write from
        -> INInt      -- ^Offset into above buffer
        -> INInt      -- ^How many to write
        -> FSWrite (FileHandle, INInt)
        -- ^Number actually written, nothing if eof
fhWrite (FileHandle{fhMode=ReadMode}) _ _ _ = throwError $ eofEx ""
fhWrite inFH@(FileHandle inodeNum filePos _) buffer buffOffset len = do
  outLen
       <- foldM (oneWrite buffer inodeNum buffOffset)
                0
                (seekPositions filePos len)
  let fh' = inFH{fhSeekPos=filePos + inIntToINLong outLen}
  return (fh', outLen)

-- |Bumps the filesize.
oneWrite :: BinHandle
         -> INInt -- Inode number
         -> INInt -- buff offset
         -> INInt -- bytes so far, inode
         -> (INLong, INInt, INInt)
         -> FSWrite INInt -- bytes so far
oneWrite buffer inodeNum buffOffset
         bytesSoFar (startPos, len', soFar) = do
  lastInode <- getInodeWrite inodeNum Nothing
  let oldSize = num_bytes $ metaData lastInode
  newLen
      <- writeBlock
         lastInode
         -- following are kinda safe due to div & mod
         (fromIntegral'' (startPos `div` intToINLong bytesPerBlock))
         (fromIntegral'' (startPos `mod` intToINLong bytesPerBlock))
         len' buffer (buffOffset + soFar)
  newInodeB <- getInodeWrite (inode_num $ metaData lastInode) Nothing
  let currSize = num_bytes $ metaData newInodeB
  -- how much bigger is this file than it was before?
  let (biggerBy::INLong)
          = startPos + (inIntToINLong newLen)
                - (assert (currSize == oldSize) currSize)
--  putStrLnWriteRead $ "would bump if > 0: " ++ (show biggerBy)
  -- bump the size if we've gone off the end:
  updateInodeCacheWrite (if biggerBy > 0
                            then inodeBumpSize newInodeB (currSize + biggerBy)
                            else newInodeB)
  return $ bytesSoFar + newLen

-- |Write a number of bytes from the given file.  Be sure to bump the
-- file size.

writeBlock :: Inode    -- The file to write into
           -> BlockNumber   -- Block number of the file to write
           -> INInt    -- Offset in the above block
           -> INInt    -- number of bytes to write
           -> BinHandle -- buffer to read from
           -> INInt    -- buffer offset; where to write this block into
           -> FSWrite INInt  -- Number of bytes written
writeBlock inInode blockNum blockOffset numBytes buffer buffOffset
    = do da  <- getDiskAddrOfBlockWrite inInode blockNum
         num <- writePartOfBlock da blockOffset buffer buffOffset numBytes
         return num

-- ------------------------------------------------------------
-- * Helpers (Rithmatic)
-- ------------------------------------------------------------

-- |Compute the start positions, lengths, and buffer offset for a read
-- call.  This takes into account the size of the buffer.
seekPositions :: INLong -- ^Start position
              -> INInt -- ^Length to read
              -> [(INLong   -- positions
                  ,INInt   -- sizes
                  ,INInt)] -- total amount read at end of read
seekPositions startPos len = seekPositions' startPos len 0

seekPositions' :: INLong -- Start position
               -> INInt -- Length to read
               -> INInt -- amount read so far
               -> [(INLong   -- positions
                   ,INInt   -- sizes
                   ,INInt)] -- total amount read at end of read
seekPositions' startPos len soFar =
    let bytesPerBlock' = intToINLong bytesPerBlock
        (thisBlockSize::Int) = fromIntegral'' $ -- safe due to 'mod'
                                if startPos < bytesPerBlock'
                                   then bytesPerBlock' - startPos
                                   else bytesPerBlock'
                                             - (startPos `mod` bytesPerBlock')
        in if len <= intToINInt thisBlockSize
           then [(startPos,len, soFar)] -- base case
           else let newPos   = startPos + (intToINLong thisBlockSize)
                    newLen   = len      - (intToINInt thisBlockSize)
                    newSoFar = soFar    + (intToINInt thisBlockSize)
                    in (startPos, intToINInt thisBlockSize, soFar)
                           :seekPositions' newPos newLen newSoFar

allocateInodeWrite :: FSWrite INInt
allocateInodeWrite = do fsr <- Halfs.FSState.get
                        let (a,b) = allocateInode fsr
                        Halfs.FSState.put b
                        return a
-- ------------------------------------------------------------
-- * Directory stuff
-- ------------------------------------------------------------

-- |Builds a brand-new, almost-empty directory.
newDirectory :: INInt   -- ^inode number
             -> Directory
newDirectory inodeNum =
  -- not really open, so mode doesn't matter
  let fhDirectory = fileHandle' inodeNum 0 ReadMode
   in Directory fhDirectory (Map.fromList [(".", inodeNum)]) True

-- |This file will always be less than INInt, not INLong. FIX: Is this
-- true? If not, we'll have to read it in chunks.
readFileFromInode :: (BinHandle -> FSRead a) -> Inode -> FSRead a
readFileFromInode f Inode{metaData=InodeMetadata{num_bytes=theSize
                                                ,inode_num=inodeNum}} = do
  let theFileHandle = fileHandle inodeNum ReadMode
  buffer <- openBinMemRW $ fromIntegral'' (assert (theSize > 0) theSize)
  readOutput <- fhRead theFileHandle buffer 0 (fromIntegral'' theSize)
  resetBinRW buffer
  assert (justSame (fromIntegral'' theSize) readOutput) (f buffer)

-- | Reads a directory from the given inode.
readDirectory :: Inode
              -> FSRead Directory
readDirectory inode@Inode{metaData=InodeMetadata{inode_num=inN}} = do
  FSRoot{directoryCache=c} <- unsafeReadGet
  case getDirectoryFromCache c inN of
    Nothing -> do m <- readFileFromInode readDirectoryBin inode
                  let d = Directory (fileHandle inN WriteMode) m True
                  unsafeModifyFSRead (\fsroot
                                      -> ((fsRootUpdateDirectoryCache d fsroot), ()))
                  return d
    Just d  -> return d

-- |fetch the inode out of the root directory
readRootDir :: FSRead Directory
readRootDir = do
  fsroot <- unsafeReadGet
  let inode = fsRootRootDirInode fsroot
  readDirectory inode

-- |FIX: are we actually freeing the inode?
unlink :: Directory
       -> String -- file to unlink
       -> FSWrite Directory
unlink dir@(Directory _ contents _) unlinkMe
    = case Map.lookup unlinkMe contents of
        Nothing -> throwError $ doesNotExistEx unlinkMe
        Just num -> do inode <- getInodeWrite num Nothing
                       let f = if (hard_links $ metaData inode) <= 1
                                then fsRootFreeInode --also takes care of dir cache.
                                else decLinksForInode
                       f inode
         -- FIX: Should we not return dir?
                       let dir' = removeChild dir unlinkMe
                       modify (fsRootUpdateDirectoryCache dir')
                       return dir'

-- |Build a directory out of this FilePath.
getDirectoryAtPath :: FilePath
                   -> FSRead Directory
getDirectoryAtPath path = do
  getSomethingAtPath (\i@Inode{metaData=InodeMetadata{mode=inM}}
         -> case assert (goodInodeMagic i) inM of
             Dir     -> readDirectory i
             File    -> throwError (userError
                           ("file encountered where directory expected"))
             SymLink -> unimplemented "Symlinks")
     path

-- |Higher level function for turning a path into an object. Uses
-- getInodeAtPath (mutually-recursive with getDirectoryAtPath) to get
-- this inode, and build something out of it. WARNING: the inode
-- returned may be an invalid inode.  Caller is responsible for
-- initializing it if it's possibly invalid.

getSomethingAtPath :: (Inode -> FSRead a)
                   -> FilePath
                   -> FSRead a
getSomethingAtPath f path = do
  inode <- getInodeAtPath path
  f (assert (goodInodeMagic inode) inode)

-- |FIX: this is in the read monad, but it'll let you make a write
-- handle if you ask for one.  The FileHandle type is not opaque so
-- that's OK!  Should work for files or directories!
openFileAtPath :: FilePath
               -> FileMode
               -> FSRead FileHandle
openFileAtPath path fMode = do
  Inode{metaData=InodeMetadata{inode_num=n}} <- getInodeAtPath path
  return $ fileHandle n fMode

-- |Uses getDirectoryAtPath (mutually recursive) to traverse down a
-- directory hierarchy to get the contents of the parent of this
-- filepath and fetch the inode from there. WARNING: the inode
-- returned may be an invalid inode.  Caller is responsible for
-- initializing it if it's possibly invalid.
getInodeAtPath :: FilePath
               -> FSRead Inode
getInodeAtPath ""  = error "getDirectoryAt: empty string"
getInodeAtPath "/" = readRootDir >>= fhInode . dirFile
getInodeAtPath ('.':'/':p) = getInodeAtPath ('/':p) -- FIX: this is a horrid hack
getInodeAtPath ('.':p) = getInodeAtPath ('/':p) -- FIX: remove when we have relative paths
getInodeAtPath dirPath = do
      unless (head dirPath == '/')
            (error $ "FIX: non-absolute path encountered: " ++ (show dirPath))
      let (parentDir, dirName) = splitFileName dirPath
      d <- getDirectoryAtPath parentDir
      case getChildWithName d dirName of
       Nothing -> throwError (doesNotExistEx dirPath)
       Just n  -> getInodeRead n Nothing

doesPathExist :: FilePath -> FSRead Bool
doesPathExist path = do
  catchError (do _ <- getInodeAtPath path -- FIX: will laziness hurt here?
                 return True)
             (\e -> if isDoesNotExistError e
                    then return False
                    else throwError e)

-- ------------------------------------------------------------
-- * Files With Names
-- ------------------------------------------------------------

-- |Might fail if parent doesn't exist.  FIX: talk to dylan about
-- special cases here handled in the java code.

-- openFileForWrite :: FSRoot -> FilePath -> IO (Maybe FileHandle)
-- openFileForWrite fsroot path = do
--   mInode <- getInodeAtPath fsroot path
--   case mInode of
--    Nothing ->
--   return $ Just $ FileHandle inode 0 WriteMode

-- ------------------------------------------------------------
-- * Tests
-- ------------------------------------------------------------

unitTests :: UnitTests
unitTests = hunitToUnitTest hunitTests

hunitTests :: [Test]
hunitTests
    = let bs  = (intToINInt bytesPerBlock)::INInt
          bs' = (intToINLong bytesPerBlock)::INLong
          in [test
              ["less than buffSize" ~: [(0,10, 0)]  ~=? seekPositions 0 10
              ,"just at buffsize"   ~: [(0, bs, 0)] ~=? seekPositions 0 bs
              ,"just over buffsize" ~: [(0, bs, 0), (bs', 1, bs)]
                                       ~=? seekPositions 0 (bs+1)
              ,"non-zero start point" ~: [(1, 10,0)] ~=? seekPositions 1 10
              ,"slop on both sides"   ~: [(10,   bs - 10, 0)
                                         ,(bs',   bs, bs-10)
                                         ,(bs'*2, 10, 2*bs-10)]
                                       ~=? seekPositions 10 (bs * 2)
             ]]

-- a good quickecheck test would be to add up all the sizes and see if
-- they equal the length.

-- |For assertion checking
justSame :: (Eq a) => a -> (b, a) -> Bool
justSame r (_, numRead) = r == numRead