module Data.Size.Instances
where
import qualified Data.List as L
import Data.Size.Base
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map as M
import qualified Foreign.Storable as FS
instance Sizeable Bool where dataOf = dataOfStorable
instance Sizeable Int where dataOf = dataOfStorable
instance Sizeable Char where dataOf = dataOfStorable
instance Sizeable Float where dataOf = dataOfStorable
instance Sizeable Double where dataOf = dataOfStorable
dataOfStorable :: FS.Storable a => a -> Bytes
dataOfStorable x
= mkBytes (FS.sizeOf x) (FS.alignment x)
dataOfBool :: Bytes
dataOfBool
= dataOfStorable (undefined :: Bool)
dataOfInt :: Bytes
dataOfInt
= dataOfStorable (undefined :: Int)
dataOfChar :: Bytes
dataOfChar
= dataOfStorable (undefined :: Char)
dataOfFloat :: Bytes
dataOfFloat
= dataOfStorable (undefined :: Float)
dataOfDouble :: Bytes
dataOfDouble
= dataOfStorable (undefined :: Double)
instance (Sizeable t1, Sizeable t2) => Sizeable (t1, t2) where
dataOf (_x1, _x2)
= 2 .*. dataOfPtr
statsOf xs@(x1, x2)
= mkStats xs
<>
statsOf x1 <> statsOf x2
instance (Sizeable t1, Sizeable t2, Sizeable t3) =>
Sizeable (t1, t2, t3) where
dataOf (_x1, _x2, _x3)
= 3 .*. dataOfPtr
statsOf xs@(x1, x2, x3)
= mkStats xs
<>
statsOf x1 <> statsOf x2 <> statsOf x3
instance (Sizeable t1, Sizeable t2, Sizeable t3, Sizeable t4) =>
Sizeable (t1, t2, t3, t4) where
dataOf (_x1, _x2, _x3, _x4)
= 4 .*. dataOfPtr
statsOf xs@(x1, x2, x3, x4)
= mkStats xs
<>
statsOf x1 <> statsOf x2 <> statsOf x3 <> statsOf x4
instance (Sizeable t) => Sizeable (Maybe t) where
dataOf x
= case x of
Just _ -> dataOfPtr
Nothing -> dataOfSingleton
statsOf x
= case x of
Just x1 -> constrStats "Just" x <> statsOf x1
Nothing -> constrStats "Nothing" x
instance (Sizeable t1, Sizeable t2) => Sizeable (Either t1 t2) where
dataOf x
= case x of
Left _ -> dataOfPtr
Right _ -> dataOfPtr
statsOf x
= case x of
Left x1 -> constrStats "Left" x <> statsOf x1
Right x1 -> constrStats "Right" x <> statsOf x1
instance Sizeable a => Sizeable [a] where
dataOf xs
= length xs .*. (dataOfConstr <> (2 .*. dataOfPtr))
bytesOf
= dataOf
statsOf xs
| null xs
= mkStats xs
| nameOf hd `elem` ["Char", "Int", "Double", "Float", "Bool"]
= mkStats xs
<>
len .*. statsOf hd
| otherwise
= mkStats xs
<>
(mconcat . L.map statsOf $ xs)
where
hd = head xs
len = length xs
instance Sizeable IS.IntSet where
dataOf s
| IS.null s
= dataOfSingleton
| otherwise
= len .*. (dataOfObj $ dataOfInt <> dataOfInt)
<>
(len 1) .*. (dataOfObj $ dataOfInt <> dataOfInt <> dataOfPtr <> dataOfPtr)
where
len = countTips s
countTips :: IS.IntSet -> Int
countTips = cnt 0 . IS.elems
where
cnt !i []
= i
cnt !i xs@(x : _)
= cnt (i + 1) $
dropWhile (\ y -> y `div` bitsPerWord == x `div` bitsPerWord) xs
bytesOf
= dataOf
statsOf
= mkStats
instance Sizeable v => Sizeable (IM.IntMap v) where
dataOf m
| IM.null m
= dataOfSingleton
| otherwise
= len .*. (dataOfObj $ dataOfInt <> dataOfPtr)
<>
(len 1) .*. (dataOfObj $ dataOfInt <> dataOfInt <> dataOfPtr <> dataOfPtr)
where
len = IM.size m
bytesOf
= dataOf
statsOf m
= mkStats m
<>
IM.foldr' ((<>) . statsOf) mempty m
instance (Sizeable k, Sizeable v) => Sizeable (M.Map k v) where
dataOf m
| M.null m
= dataOfSingleton
| otherwise
= len .*. (dataOfObj $ dataOfInt <> 4 .*. dataOfPtr)
where
len = M.size m
bytesOf
= dataOf
statsOf m
= mkStats m
<>
(mconcat . L.map (uncurry statsOfPair) $ M.toList m)
where
statsOfPair k v
= statsOf k <> statsOf v
instance Sizeable BS.ByteString where
dataOf bs
= (dataOfPtr <> 2 .*. dataOfInt)
<> (dataOfObj $ dataOfPtr <> dataOfPtr)
<> (wordAlign $
BS.length bs .*. dataOfChar
)
statsOf s
= mkStats s
instance Sizeable BL.ByteString where
nameOf
= (++ " (lazy)") . typeName
dataOf bs
= length cs .*. (dataOfObj $ dataOfPtr <> dataOfPtr)
<>
(mconcat . L.map bytesOf $ cs)
where
cs = BL.toChunks bs
bytesOf
= dataOf
statsOf
= mkStats