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"


---------------------------------------------------------------------------------------- YYYYsMMsDD
-- | Human readable ASCII date in YYYYsMMsDD format.
data YYYYsMMsDD         = YYYYsMMsDD Char       deriving (YYYYsMMsDD -> YYYYsMMsDD -> Bool
(YYYYsMMsDD -> YYYYsMMsDD -> Bool)
-> (YYYYsMMsDD -> YYYYsMMsDD -> Bool) -> Eq YYYYsMMsDD
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YYYYsMMsDD -> YYYYsMMsDD -> Bool
== :: YYYYsMMsDD -> YYYYsMMsDD -> Bool
$c/= :: YYYYsMMsDD -> YYYYsMMsDD -> Bool
/= :: YYYYsMMsDD -> YYYYsMMsDD -> Bool
Eq, Int -> YYYYsMMsDD -> ShowS
[YYYYsMMsDD] -> ShowS
YYYYsMMsDD -> String
(Int -> YYYYsMMsDD -> ShowS)
-> (YYYYsMMsDD -> String)
-> ([YYYYsMMsDD] -> ShowS)
-> Show YYYYsMMsDD
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YYYYsMMsDD -> ShowS
showsPrec :: Int -> YYYYsMMsDD -> ShowS
$cshow :: YYYYsMMsDD -> String
show :: YYYYsMMsDD -> String
$cshowList :: [YYYYsMMsDD] -> ShowS
showList :: [YYYYsMMsDD] -> ShowS
Show)
instance Format YYYYsMMsDD where
 type Value YYYYsMMsDD  = Date32
 fieldCount :: YYYYsMMsDD -> Int
fieldCount YYYYsMMsDD
_           = Int
1
 minSize :: YYYYsMMsDD -> Int
minSize    YYYYsMMsDD
_           = Int
10
 fixedSize :: YYYYsMMsDD -> Maybe Int
fixedSize  YYYYsMMsDD
_           = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10
 packedSize :: YYYYsMMsDD -> Value YYYYsMMsDD -> Maybe Int
packedSize YYYYsMMsDD
_ Value YYYYsMMsDD
_         = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10
 {-# INLINE minSize    #-}
 {-# INLINE fieldCount #-}
 {-# INLINE fixedSize  #-}
 {-# INLINE packedSize #-}


instance Packable YYYYsMMsDD where

 pack :: YYYYsMMsDD -> Value YYYYsMMsDD -> Packer
pack  (YYYYsMMsDD Char
s) !Value YYYYsMMsDD
v
  = let (Int
yy', Int
mm', Int
dd') = Date32 -> (Int, Int, Int)
Date32.unpack Date32
Value YYYYsMMsDD
v
        !yy :: Int
yy     = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yy'
        !mm :: Int
mm     = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mm'
        !dd :: Int
dd     = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dd'
    in     IntAsc0 -> Value IntAsc0 -> Packer
forall format. Packable format => format -> Value format -> Packer
pack (Int -> IntAsc0
IntAsc0 Int
4) Int
Value IntAsc0
yy
        Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> Word8be -> Value Word8be -> Packer
forall format. Packable format => format -> Value format -> Packer
pack Word8be
Word8be     (Char -> Word8
cw8 Char
s)
        Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> IntAsc0 -> Value IntAsc0 -> Packer
forall format. Packable format => format -> Value format -> Packer
pack (Int -> IntAsc0
IntAsc0 Int
2) Int
Value IntAsc0
mm
        Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> Word8be -> Value Word8be -> Packer
forall format. Packable format => format -> Value format -> Packer
pack Word8be
Word8be     (Char -> Word8
cw8 Char
s)
        Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> IntAsc0 -> Value IntAsc0 -> Packer
forall format. Packable format => format -> Value format -> Packer
pack (Int -> IntAsc0
IntAsc0 Int
2) Int
Value IntAsc0
dd
 {-# INLINE pack #-}

 packer :: YYYYsMMsDD
-> Value YYYYsMMsDD -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer YYYYsMMsDD
f Value YYYYsMMsDD
v
  = Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
fromPacker (YYYYsMMsDD -> Value YYYYsMMsDD -> Packer
forall format. Packable format => format -> Value format -> Packer
pack YYYYsMMsDD
f Value YYYYsMMsDD
v)
 {-# INLINE packer #-}



instance Unpackable YYYYsMMsDD where

 unpacker :: YYYYsMMsDD
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value YYYYsMMsDD -> IO ())
-> IO ()
unpacker (YYYYsMMsDD Char
s) Addr#
start Addr#
end Word8 -> Bool
_stop IO ()
fail Addr# -> Value YYYYsMMsDD -> IO ()
eat
  = do  let len :: Int
len = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
end Addr#
start)
        Maybe (Date32, Int)
r       <- Word8 -> Ptr Word8 -> Int -> IO (Maybe (Date32, Int))
Date32.loadYYYYsMMsDD (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
s) (Addr# -> Ptr Word8
pw8 Addr#
start) Int
len
        case Maybe (Date32, Int)
r of
         Just (Date32
d, I# Int#
o) -> Addr# -> Value YYYYsMMsDD -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
o) Date32
Value YYYYsMMsDD
d
         Maybe (Date32, Int)
Nothing        -> IO ()
fail
 {-# INLINE unpacker #-}


---------------------------------------------------------------------------------------- DDsMMsYYYY
-- | Human readable ASCII date in DDsMMsYYYY format.
data DDsMMsYYYY         = DDsMMsYYYY Char       deriving (DDsMMsYYYY -> DDsMMsYYYY -> Bool
(DDsMMsYYYY -> DDsMMsYYYY -> Bool)
-> (DDsMMsYYYY -> DDsMMsYYYY -> Bool) -> Eq DDsMMsYYYY
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DDsMMsYYYY -> DDsMMsYYYY -> Bool
== :: DDsMMsYYYY -> DDsMMsYYYY -> Bool
$c/= :: DDsMMsYYYY -> DDsMMsYYYY -> Bool
/= :: DDsMMsYYYY -> DDsMMsYYYY -> Bool
Eq, Int -> DDsMMsYYYY -> ShowS
[DDsMMsYYYY] -> ShowS
DDsMMsYYYY -> String
(Int -> DDsMMsYYYY -> ShowS)
-> (DDsMMsYYYY -> String)
-> ([DDsMMsYYYY] -> ShowS)
-> Show DDsMMsYYYY
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DDsMMsYYYY -> ShowS
showsPrec :: Int -> DDsMMsYYYY -> ShowS
$cshow :: DDsMMsYYYY -> String
show :: DDsMMsYYYY -> String
$cshowList :: [DDsMMsYYYY] -> ShowS
showList :: [DDsMMsYYYY] -> ShowS
Show)
instance Format DDsMMsYYYY where
 type Value DDsMMsYYYY  = Date32
 fieldCount :: DDsMMsYYYY -> Int
fieldCount DDsMMsYYYY
_           = Int
1
 minSize :: DDsMMsYYYY -> Int
minSize    DDsMMsYYYY
_           = Int
10
 fixedSize :: DDsMMsYYYY -> Maybe Int
fixedSize  DDsMMsYYYY
_           = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10
 packedSize :: DDsMMsYYYY -> Value DDsMMsYYYY -> Maybe Int
packedSize DDsMMsYYYY
_ Value DDsMMsYYYY
_         = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10
 {-# INLINE minSize    #-}
 {-# INLINE fieldCount #-}
 {-# INLINE fixedSize  #-}
 {-# INLINE packedSize #-}


instance Packable DDsMMsYYYY where

 pack :: DDsMMsYYYY -> Value DDsMMsYYYY -> Packer
pack   (DDsMMsYYYY Char
s) !Value DDsMMsYYYY
v
  = let (Int
yy', Int
mm', Int
dd') = Date32 -> (Int, Int, Int)
Date32.unpack Date32
Value DDsMMsYYYY
v
        !yy :: Int
yy     = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yy'
        !mm :: Int
mm     = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mm'
        !dd :: Int
dd     = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dd'
    in     IntAsc0 -> Value IntAsc0 -> Packer
forall format. Packable format => format -> Value format -> Packer
pack (Int -> IntAsc0
IntAsc0 Int
2) Int
Value IntAsc0
dd
        Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> Word8be -> Value Word8be -> Packer
forall format. Packable format => format -> Value format -> Packer
pack Word8be
Word8be     (Char -> Word8
cw8 Char
s)
        Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> IntAsc0 -> Value IntAsc0 -> Packer
forall format. Packable format => format -> Value format -> Packer
pack (Int -> IntAsc0
IntAsc0 Int
2) Int
Value IntAsc0
mm
        Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> Word8be -> Value Word8be -> Packer
forall format. Packable format => format -> Value format -> Packer
pack Word8be
Word8be     (Char -> Word8
cw8 Char
s)
        Packer -> Packer -> Packer
forall a. Semigroup a => a -> a -> a
<> IntAsc0 -> Value IntAsc0 -> Packer
forall format. Packable format => format -> Value format -> Packer
pack (Int -> IntAsc0
IntAsc0 Int
4) Int
Value IntAsc0
yy
 {-# INLINE pack #-}

 packer :: DDsMMsYYYY
-> Value DDsMMsYYYY -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer DDsMMsYYYY
f Value DDsMMsYYYY
v
  = Packer -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
fromPacker (DDsMMsYYYY -> Value DDsMMsYYYY -> Packer
forall format. Packable format => format -> Value format -> Packer
pack DDsMMsYYYY
f Value DDsMMsYYYY
v)
 {-# INLINE packer #-}



instance Unpackable DDsMMsYYYY where

 unpacker :: DDsMMsYYYY
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value DDsMMsYYYY -> IO ())
-> IO ()
unpacker (DDsMMsYYYY Char
s) Addr#
start Addr#
end Word8 -> Bool
_stop IO ()
fail Addr# -> Value DDsMMsYYYY -> IO ()
eat
  = do
        let len :: Int
len = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
end Addr#
start)
        Maybe (Date32, Int)
r       <- Word8 -> Ptr Word8 -> Int -> IO (Maybe (Date32, Int))
Date32.loadDDsMMsYYYY (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
s) (Addr# -> Ptr Word8
pw8 Addr#
start) Int
len
        case Maybe (Date32, Int)
r of
         Just (Date32
d, I# Int#
o)    -> Addr# -> Value DDsMMsYYYY -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
o) Date32
Value DDsMMsYYYY
d
         Maybe (Date32, Int)
Nothing           -> IO ()
fail
 {-# INLINE unpacker #-}


---------------------------------------------------------------------------------------------------
cw8 :: Char -> Word8
cw8 :: Char -> Word8
cw8 Char
c = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c
{-# INLINE cw8 #-}

pw8 :: Addr# -> Ptr Word8
pw8 :: Addr# -> Ptr Word8
pw8 Addr#
addr = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr
{-# INLINE pw8 #-}