1 {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 module Databrary.Model.Age 3 ( Age(..) 4 , age 5 , yearsAge 6 , ageTime 7 , ageLimit 8 ) where 9 10 import Data.Time (diffDays, DiffTime, secondsToDiffTime) 11 12 import qualified Databrary.JSON as JSON 13 import Databrary.Model.Time 14 15 newtype Age = 16 Age { 17 ageDays :: Int -- ^ Totals days constituting age. E.g. 1.5 years old = 548 days 18 } deriving (Eq, Ord) -- (Num, Show) 19 20 instance JSON.ToJSON Age where 21 toJSON (Age days) = JSON.Number $ fromIntegral days 22 23 -- | subtract second date (usually current date) from first date (birthdate), convert difference into age 24 age :: Date -> Date -> Age 25 age b d = Age $ fromInteger $ diffDays d b 26 27 -- | convert a fractional value of years into a count of days, building an Age object with that value 28 yearsAge :: Real a => a -> Age 29 yearsAge y = Age $ ceiling $ (365.24219 :: Double) * realToFrac y 30 31 -- | convert total days spanning an Age value into the equivalent number of seconds (as a time interval) 32 ageTime :: Age -> DiffTime 33 ageTime (Age n) = secondsToDiffTime $ 86400 * fromIntegral n 34 35 -- | upper bound for allowed age values, intended for validation 36 ageLimit :: Age 37 ageLimit = yearsAge (90 :: Double)