module Data.HodaTime.Calendar.Gregorian.CacheTable
(
   DTCacheTable(..)
  ,cacheTable
  ,decodeYear
  ,decodeMonth
  ,decodeDay
  ,decodeHour
  ,decodeMinute
  ,decodeSecond
)
where

import Data.Word (Word16)
import Data.Bits (shift, (.|.), (.&.), shiftR)
import Data.Array.Unboxed (array, UArray)

type DTCacheDaysTable = UArray Int Word16
type DTCacheHoursTable = UArray Int Word16

data DTCacheTable = DTCacheTable DTCacheDaysTable DTCacheHoursTable

-- TODO: The start date is offset but otherwise the months are all in their
--        unrotated form (i.e. Jan/Feb are in their normal year, not the previous year).
--        does this hurt anything?  It's nice for decoding but maybe some math expects
--        Jan/Feb to be (year - 1)

-- The Cache Table holds years and hours in the following format:
-- +-----+----+----+  +----+----+----+
-- |0-100|1-12|1-31|  |0-11|0-59|0-59|
-- +-----+----+----+  +----+----+----+
--    7     4   5        4    6    6
-- Meaning we can store 100 years of days and 12 hours of seconds in 16 bits each
cacheTable :: DTCacheTable
cacheTable :: DTCacheTable
cacheTable = DTCacheDaysTable -> DTCacheDaysTable -> DTCacheTable
DTCacheTable DTCacheDaysTable
days DTCacheDaysTable
hours where
  toArray :: [e] -> a Int e
toArray [e]
xs = (Int, Int) -> [(Int, e)] -> a Int e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
0, [e] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [e]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([(Int, e)] -> a Int e) -> [(Int, e)] -> a Int e
forall a b. (a -> b) -> a -> b
$ [Int] -> [e] -> [(Int, e)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [e]
xs
  days :: DTCacheDaysTable
days = [Word16] -> DTCacheDaysTable
forall {a :: * -> * -> *} {e}. IArray a e => [e] -> a Int e
toArray ([Word16] -> DTCacheDaysTable) -> [Word16] -> DTCacheDaysTable
forall a b. (a -> b) -> a -> b
$ [Word16]
firstYear [Word16] -> [Word16] -> [Word16]
forall a. [a] -> [a] -> [a]
++ [Word16]
years [Word16] -> [Word16] -> [Word16]
forall a. [a] -> [a] -> [a]
++ [Word16]
lastYear
  firstYear :: [Word16]
firstYear = [ Word16 -> Word16 -> Word16 -> Word16
encodeDate Word16
0 Word16
m Word16
d | Word16
m <- [Word16
2..Word16
11], Word16
d <- Word16 -> Word16 -> [Word16]
daysInMonth Word16
m Word16
0]
  years :: [Word16]
years = [ Word16 -> Word16 -> Word16 -> Word16
encodeDate Word16
y Word16
m Word16
d | Word16
y <- [Word16
1..Word16
99], Word16
m <- [Word16
0..Word16
11], Word16
d <- Word16 -> Word16 -> [Word16]
daysInMonth Word16
m Word16
y]
  lastYear :: [Word16]
lastYear = [ Word16 -> Word16 -> Word16 -> Word16
encodeDate Word16
100 Word16
m Word16
d | Word16
m <- [Word16
0, Word16
1], Word16
d <- Word16 -> Word16 -> [Word16]
daysInMonth Word16
m Word16
100]
  hours :: DTCacheDaysTable
hours = [Word16] -> DTCacheDaysTable
forall {a :: * -> * -> *} {e}. IArray a e => [e] -> a Int e
toArray [ Word16 -> Word16 -> Word16 -> Word16
encodeTime Word16
h Word16
m Word16
s | Word16
h <- [Word16
0..Word16
11], Word16
m <- [Word16
0..Word16
59], Word16
s <- [Word16
0..Word16
59]]

-- encode

yearShift :: Num a => a
yearShift :: forall a. Num a => a
yearShift = a
9

monthShift :: Num a => a
monthShift :: forall a. Num a => a
monthShift = a
5

encodeDate :: Word16 -> Word16 -> Word16 -> Word16
encodeDate :: Word16 -> Word16 -> Word16 -> Word16
encodeDate Word16
y Word16
m Word16
d = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shift Word16
y Int
forall a. Num a => a
yearShift Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shift Word16
m Int
forall a. Num a => a
monthShift Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
d

-- Annoying to semi replicate this logic but otherwise we have to move much of this code to Internal to use the enums
daysInMonth :: Word16 -> Word16 -> [Word16]
daysInMonth :: Word16 -> Word16 -> [Word16]
daysInMonth Word16
1 Word16
y
  | Bool
isLeap                                      = [Word16
1..Word16
29]
  | Bool
otherwise                                   = [Word16
1..Word16
28]
  where
    isLeap :: Bool
isLeap
      | Word16
0 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
y Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`mod` Word16
100                        = Bool
False           -- 400+ is not possible here
      | Bool
otherwise                               = Word16
0 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
y Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`mod` Word16
4
daysInMonth Word16
n Word16
_
  | Word16
n Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
3 Bool -> Bool -> Bool
|| Word16
n Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
5 Bool -> Bool -> Bool
|| Word16
n Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
8 Bool -> Bool -> Bool
|| Word16
n Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
10       = [Word16
1..Word16
30]
  | Bool
otherwise                                   = [Word16
1..Word16
31]

hourShift :: Num a => a
hourShift :: forall a. Num a => a
hourShift = a
12

minuteShift :: Num a => a
minuteShift :: forall a. Num a => a
minuteShift = a
6

encodeTime :: Word16 -> Word16 -> Word16 -> Word16
encodeTime :: Word16 -> Word16 -> Word16 -> Word16
encodeTime Word16
h Word16
m Word16
s = Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shift Word16
h Int
forall a. Num a => a
hourShift Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shift Word16
m Int
forall a. Num a => a
minuteShift Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
s

-- decode dates

yearMask :: Num a => a
yearMask :: forall a. Num a => a
yearMask = a
65024

decodeYear :: Word16 -> Word16
decodeYear :: Word16 -> Word16
decodeYear = (Word16 -> Int -> Word16) -> Int -> Word16 -> Word16
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Int
forall a. Num a => a
yearShift (Word16 -> Word16) -> (Word16 -> Word16) -> Word16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.&.) Word16
forall a. Num a => a
yearMask

monthMask :: Num a => a
monthMask :: forall a. Num a => a
monthMask = a
480

decodeMonth :: Word16 -> Word16
decodeMonth :: Word16 -> Word16
decodeMonth = (Word16 -> Int -> Word16) -> Int -> Word16 -> Word16
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Int
forall a. Num a => a
monthShift (Word16 -> Word16) -> (Word16 -> Word16) -> Word16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.&.) Word16
forall a. Num a => a
monthMask

dayMask :: Num a => a
dayMask :: forall a. Num a => a
dayMask = a
31

decodeDay :: Word16 -> Word16
decodeDay :: Word16 -> Word16
decodeDay = Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.&.) Word16
forall a. Num a => a
dayMask

-- decode time

hourMask :: Num a => a
hourMask :: forall a. Num a => a
hourMask = a
61440

decodeHour :: Word16 -> Word16
decodeHour :: Word16 -> Word16
decodeHour = (Word16 -> Int -> Word16) -> Int -> Word16 -> Word16
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Int
forall a. Num a => a
hourShift (Word16 -> Word16) -> (Word16 -> Word16) -> Word16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.&.) Word16
forall a. Num a => a
hourMask

minuteMask :: Num a => a
minuteMask :: forall a. Num a => a
minuteMask = a
4032

decodeMinute :: Word16 -> Word16
decodeMinute :: Word16 -> Word16
decodeMinute = (Word16 -> Int -> Word16) -> Int -> Word16 -> Word16
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Int
forall a. Num a => a
minuteShift (Word16 -> Word16) -> (Word16 -> Word16) -> Word16 -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.&.) Word16
forall a. Num a => a
minuteMask

secondMask :: Num a => a
secondMask :: forall a. Num a => a
secondMask = a
63

decodeSecond :: Word16 -> Word16
decodeSecond :: Word16 -> Word16
decodeSecond = Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
(.&.) Word16
forall a. Num a => a
secondMask