module Data.Repa.Convert.Format.Date32
( YYYYsMMsDD (..)
, DDsMMsYYYY (..))
where
import Data.Repa.Convert.Internal.Packable
import Data.Repa.Convert.Internal.Packer
import Data.Repa.Convert.Format.Numeric
import Data.Repa.Convert.Format.Binary
import Data.Monoid
import Data.Char
import Data.Word
import GHC.Exts
import Data.Repa.Scalar.Date32 (Date32)
import qualified Data.Repa.Scalar.Date32 as Date32
import Prelude hiding (fail)
#include "repa-convert.h"
data YYYYsMMsDD = YYYYsMMsDD Char deriving (Eq, Show)
instance Format YYYYsMMsDD where
type Value YYYYsMMsDD = Date32
fieldCount _ = 1
minSize _ = 10
fixedSize _ = Just 10
packedSize _ _ = Just 10
instance Packable YYYYsMMsDD where
pack (YYYYsMMsDD s) !v
= let (yy', mm', dd') = Date32.unpack v
!yy = fromIntegral yy'
!mm = fromIntegral mm'
!dd = fromIntegral dd'
in pack (IntAsc0 4) yy
<> pack Word8be (cw8 s)
<> pack (IntAsc0 2) mm
<> pack Word8be (cw8 s)
<> pack (IntAsc0 2) dd
packer f v
= fromPacker (pack f v)
instance Unpackable YYYYsMMsDD where
unpacker (YYYYsMMsDD s) start end _stop fail eat
= do let len = I# (minusAddr# end start)
r <- Date32.loadYYYYsMMsDD (fromIntegral $ ord s) (pw8 start) len
case r of
Just (d, I# o) -> eat (plusAddr# start o) d
Nothing -> fail
data DDsMMsYYYY = DDsMMsYYYY Char deriving (Eq, Show)
instance Format DDsMMsYYYY where
type Value DDsMMsYYYY = Date32
fieldCount _ = 1
minSize _ = 10
fixedSize _ = Just 10
packedSize _ _ = Just 10
instance Packable DDsMMsYYYY where
pack (DDsMMsYYYY s) !v
= let (yy', mm', dd') = Date32.unpack v
!yy = fromIntegral yy'
!mm = fromIntegral mm'
!dd = fromIntegral dd'
in pack (IntAsc0 2) dd
<> pack Word8be (cw8 s)
<> pack (IntAsc0 2) mm
<> pack Word8be (cw8 s)
<> pack (IntAsc0 4) yy
packer f v
= fromPacker (pack f v)
instance Unpackable DDsMMsYYYY where
unpacker (DDsMMsYYYY s) start end _stop fail eat
= do
let len = I# (minusAddr# end start)
r <- Date32.loadDDsMMsYYYY (fromIntegral $ ord s) (pw8 start) len
case r of
Just (d, I# o) -> eat (plusAddr# start o) d
Nothing -> fail
cw8 :: Char -> Word8
cw8 c = fromIntegral $ ord c
pw8 :: Addr# -> Ptr Word8
pw8 addr = Ptr addr