{-# LINE 1 "System/Linux/Btrfs/Time.hsc" #-}
module System.Linux.Btrfs.Time
{-# LINE 2 "System/Linux/Btrfs/Time.hsc" #-}
    ( BtrfsTime(..)
    ) where

import Data.Time.Format ()
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Word.Endian (LE32(..), LE64(..))
import Data.Ratio ((%))

import Foreign.Storable (Storable(..))
import Foreign.C.Types (CInt)


{-# LINE 15 "System/Linux/Btrfs/Time.hsc" #-}

newtype BtrfsTime = BtrfsTime UTCTime

instance Storable BtrfsTime where
    sizeOf _ = ((12))
{-# LINE 20 "System/Linux/Btrfs/Time.hsc" #-}
    alignment _ = alignment (undefined :: CInt)
    poke _ _ = error "not implemented"
    peek ptr = do
        LE64 sec  <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 24 "System/Linux/Btrfs/Time.hsc" #-}
        LE32 nsec <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 25 "System/Linux/Btrfs/Time.hsc" #-}
        let frac = toInteger nsec % 1000000000
        return $ BtrfsTime $ posixSecondsToUTCTime $
            fromRational $ toRational sec + frac