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)