{-# LANGUAGE PatternSignatures #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  TheBlockMap
--
-- Maintainer  :  Isaac Jones <ijones@galois.com>
-- Stability   :  alpha
-- Portability :  GHC
--
-- Explanation: Tracks free blocks in the filesystem.  Does not track
-- non-free blocks.  Exists as a FIFO queue to avoid block reuse.
-- This is also true when syncing to the disk; it syncs in FIFO order,
-- so when its read from the disk, the least-recently-used block is on
-- the end, and won't be used for a while.  -- The number of bytes in
-- the block map file does _not_ change, but not all of those bytes
-- will always be used.  That is, the block map file is a fixed size,
-- does not shrink after newFS.

module Halfs.TheBlockMap (TheBlockMap	-- abstract
			 ,mkBlockMap
                         ,allocateBlock
                         ,freeBlock
			 ,freeBlocks
			 ,bmTotalSize
			 ,bmDirty
                         ,newFS
                         ,findAddress
                         ,unitTests)
    where

import Halfs.Inode  (Inode(metaData), InodeMetadata(level)
                    ,newInode, firstFreeInodeDiskAddr)
import Halfs.TestFramework (Test(..), UnitTests, (~:), (~=?),
                            hunitToUnitTest)
import Data.Integral ( INInt, intToINInt )
import Halfs.Utils  (DiskAddress, BlockNumber,
                     FileType (File),
		     blockPointersPerIndirectBlock,
		     blockPointersPerInode)

-- Base
import Data.Queue (listToQueue, addToQueue, deQueue, Queue, queueToList, queueLength)
import qualified Data.Set as Set
import Control.Exception(assert)

-- TODO: each block of blockmap should have a dirty bit (inside the
-- inode)
data TheBlockMap = TheBlockMap {freeBlocks :: Queue DiskAddress
			       ,_freeBlocksSet :: Set.Set DiskAddress
                               ,bmDirty    :: Bool
                               ,bmTotalSize :: INInt -- total number of blocks
                               }

-- |todo: check to see if new epoch, optimize allocation by using a
-- window and passing in a hint of where it "should" go. "Nothing"
-- means that the disk is full.

allocateBlock :: TheBlockMap -> Maybe (DiskAddress, TheBlockMap)
allocateBlock (TheBlockMap inBlockMap inBlockSet _ s)
    = case deQueue inBlockMap of
       Nothing -> Nothing  -- Nothing free!
       Just (addr, newBlockMap)
           -> Just ((assert (addr /= 0) addr), TheBlockMap newBlockMap (Set.delete addr inBlockSet) True s)

freeBlock :: TheBlockMap -> DiskAddress -> TheBlockMap
freeBlock (TheBlockMap inBlockMap inBlockSet _ len) addr
    = assert (not (Set.member addr inBlockSet)) $
      assert (addr > 0 && addr < len) $
      TheBlockMap (addToQueue inBlockMap (assert (addr /= 0) addr)) (Set.insert addr inBlockSet) True len
{-
  where addToQueue' q addr = listToQueue (take offset xs ++ [addr] ++ drop offset xs)
	   where xs = queueToList q
	 	 offset = 200
-}
-- |smart constructor for TheBlockMap
newFS :: INInt       -- ^Length of the device in blocks
      -> TheBlockMap
newFS len -- 0 and 1 are inode file and inodemap file
    = mkBlockMap (listToQueue [firstFreeInodeDiskAddr .. (len - 1)]) True len

mkBlockMap :: Queue DiskAddress -> Bool -> INInt -> TheBlockMap
mkBlockMap free busy size
    = assert (queueLength free == Set.size freeSet) $
      TheBlockMap free freeSet busy size
   where freeSet = Set.fromList (queueToList free)

instance Show TheBlockMap where
   show (TheBlockMap free _ de tot) = "TheBlockMap [" ++ showBM (queueToList free) ++ "] " ++ show de ++ " " ++ show tot
     where
	commas [] = ""
	commas xs = foldl1 (\ a b -> a ++ "," ++ b) xs
	showBM xs = commas
		      [ if a == b
			then
			show a
			else show a ++ ".." ++ show b
		     | (a,b) <- combine [ (x,x) | x <- xs ] ]
        combine ((a,b):(c,d):r) | b+1 == c = combine ((a,d):r)
	combine (v:r) = v: combine r
        combine []    = []

{-
instance Show TheBlockMap where
  show (TheBlockMap fb _ _)
      = fmap (\x -> if isFree x then "-" else "X")
-}

-- ------------------------------------------------------------
-- * Computing the location on disk of this block
-- ------------------------------------------------------------

findAddress :: Inode       -- ^Inode that contains the blocks
            -> BlockNumber -- ^Address we're looking for, 0 indexed
            -> [INInt]     -- ^dereference locations at each level, 0 indexed
findAddress inode findMe
    = addrList (level $ metaData inode)
               1
               (intToINInt blockPointersPerIndirectBlock)
               (intToINInt blockPointersPerInode)
               findMe

-- |Compute the list of locations in a tree with the given branching
-- factor. Counts up to totalLevels, zero indexed. That is, if I'm
-- looking for the 3rd element in a zero indexed binary tree with two
-- levels, it'll be [1,1]. addrList 3 3 2 10 == [1,0,1]

addrList :: INInt -- Levels
         -> INInt -- current level
         -> INInt -- branching factor
         -> INInt -- base buckets
         -> BlockNumber -- address to find
         -> [INInt]
addrList totalLevels currLevel branchingFactor baseBuckets findMe
    | findMe >= numBuckets totalLevels branchingFactor baseBuckets
        = error "block too big, should have resized"
    | currLevel > totalLevels = []
    | otherwise = let bucketLoc = absBucket totalLevels currLevel
                                            branchingFactor baseBuckets findMe
                      prevLevel = currLevel - 1
                      prevBucket = absBucket totalLevels prevLevel
                                             branchingFactor baseBuckets findMe
                      answer = if currLevel == 1
                               then bucketLoc
                               else bucketLoc - (branchingFactor * prevBucket)
                  in answer : (addrList totalLevels (currLevel + 1)
                                        branchingFactor baseBuckets findMe)

-- |How many buckets at this level for this branching factor?
numBuckets :: INInt -- current level
           -> INInt -- branching factor
           -> INInt -- base buckets
           -> INInt
numBuckets 0 _ _ = error "zero"
numBuckets 1 _ b = b
numBuckets currLevel branchingFactor baseBuckets
    = (numBuckets (currLevel - 1) branchingFactor baseBuckets) * branchingFactor

-- Get the bucket of this element as if this entire level were one node
absBucket :: INInt -- total levels
          -> INInt -- current level
          -> INInt -- branching factor
          -> INInt -- base buckets
          -> BlockNumber -- location to find.
          -> INInt
absBucket _ _ _ _ 0 = 0
absBucket totalLevels currLevel branchingFactor baseBuckets findMe =
  let maxElems       = numBuckets totalLevels branchingFactor baseBuckets
      buckets        = numBuckets currLevel   branchingFactor baseBuckets
      itemsPerBucket = maxElems `div` (assert (buckets /= 0) buckets)
   -- Below "1" adjustments are because addresses start at zero.
  in (ceiling $ toRational (findMe+1) / toRational itemsPerBucket) - 1

-- ------------------------------------------------------------
-- * Testing
-- ------------------------------------------------------------

unitTests :: UnitTests
unitTests = hunitToUnitTest hunitTests

hunitTests :: [Test]
hunitTests = let inode' = newInode 0 File
                 inode = inode'{metaData=(metaData inode'){level=2}}
                 inode2 = inode'{metaData=(metaData inode'){level=3}}
                 (maxAddr::INInt) = (16 * (1024 ^ (2::Int))) - 1 -- for 3 levels
             in
            ["simple Address List 1" ~: "failed" ~: [1,0,1] ~=? addrList 3 1 3 2 10
            ,"simple Address List 2" ~: "failed" ~: [1,0,2] ~=? addrList 3 1 3 2 11
            ,"simple Address List 2" ~: "failed" ~: [1,1,1] ~=? addrList 3 1 3 2 13
            ,"disk addr list 1" ~: "failed" ~: [0,0] ~=? findAddress inode 0
            ,"disk addr list 2" ~: "failed" ~: [0,1] ~=? findAddress inode 1
            ,"disk addr list 3" ~: "failed" ~: [0,1023] ~=? findAddress inode 1023
            ,"disk addr list 4" ~: "failed" ~: [1,0] ~=? findAddress inode 1024
            ,"disk addr list 3 lev. 1" ~: "failed" ~: [0,1,0] ~=? findAddress inode2 1024
            ,"disk addr list 3 lev. 2" ~: "failed"
                                           ~: [0,0,1023] ~=? findAddress inode2 1023
            ,"disk addr list 3 lev. 3" ~: "failed" ~: [0,5,0] ~=? findAddress inode2 5120
            ,"max addr" ~: "failed" ~: maxAddr ~=? (numBuckets 3 1024 16) - 1
            ,"max addr loc" ~: "failed" ~: [15, 1023, 1023]
                            ~=? findAddress inode2 maxAddr
            -- FIX: Should test address maxAddr + 1 which should fail
            ]