{-# LANGUAGE Safe #-} module Data.Time.Calendar.Private where import Data.Fixed data PadOption = Pad Int Char | NoPad showPadded :: PadOption -> String -> String showPadded :: PadOption -> String -> String showPadded PadOption NoPad String s = String s showPadded (Pad Int i Char c) String s = Int -> Char -> String forall a. Int -> a -> [a] replicate (Int i Int -> Int -> Int forall a. Num a => a -> a -> a - String -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length String s) Char c String -> String -> String forall a. [a] -> [a] -> [a] ++ String s class (Num t, Ord t, Show t) => ShowPadded t where showPaddedNum :: PadOption -> t -> String instance ShowPadded Integer where showPaddedNum :: PadOption -> Integer -> String showPaddedNum PadOption NoPad Integer i = Integer -> String forall a. Show a => a -> String show Integer i showPaddedNum PadOption pad Integer i | Integer i Integer -> Integer -> Bool forall a. Ord a => a -> a -> Bool < Integer 0 = Char '-' Char -> String -> String forall a. a -> [a] -> [a] : (PadOption -> Integer -> String forall t. ShowPadded t => PadOption -> t -> String showPaddedNum PadOption pad (Integer -> Integer forall a. Num a => a -> a negate Integer i)) showPaddedNum PadOption pad Integer i = PadOption -> String -> String showPadded PadOption pad (String -> String) -> String -> String forall a b. (a -> b) -> a -> b $ Integer -> String forall a. Show a => a -> String show Integer i instance ShowPadded Int where showPaddedNum :: PadOption -> Int -> String showPaddedNum PadOption NoPad Int i = Int -> String forall a. Show a => a -> String show Int i showPaddedNum PadOption _pad Int i | Int i Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int forall a. Bounded a => a minBound = Int -> String forall a. Show a => a -> String show Int i showPaddedNum PadOption pad Int i | Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 = Char '-' Char -> String -> String forall a. a -> [a] -> [a] : (PadOption -> Int -> String forall t. ShowPadded t => PadOption -> t -> String showPaddedNum PadOption pad (Int -> Int forall a. Num a => a -> a negate Int i)) showPaddedNum PadOption pad Int i = PadOption -> String -> String showPadded PadOption pad (String -> String) -> String -> String forall a b. (a -> b) -> a -> b $ Int -> String forall a. Show a => a -> String show Int i show2Fixed :: Pico -> String show2Fixed :: Pico -> String show2Fixed Pico x | Pico x Pico -> Pico -> Bool forall a. Ord a => a -> a -> Bool < Pico 10 = Char '0' Char -> String -> String forall a. a -> [a] -> [a] : (Bool -> Pico -> String forall k (a :: k). HasResolution a => Bool -> Fixed a -> String showFixed Bool True Pico x) show2Fixed Pico x = Bool -> Pico -> String forall k (a :: k). HasResolution a => Bool -> Fixed a -> String showFixed Bool True Pico x show2 :: (ShowPadded t) => t -> String show2 :: t -> String show2 = PadOption -> t -> String forall t. ShowPadded t => PadOption -> t -> String showPaddedNum (PadOption -> t -> String) -> PadOption -> t -> String forall a b. (a -> b) -> a -> b $ Int -> Char -> PadOption Pad Int 2 Char '0' show3 :: (ShowPadded t) => t -> String show3 :: t -> String show3 = PadOption -> t -> String forall t. ShowPadded t => PadOption -> t -> String showPaddedNum (PadOption -> t -> String) -> PadOption -> t -> String forall a b. (a -> b) -> a -> b $ Int -> Char -> PadOption Pad Int 3 Char '0' show4 :: (ShowPadded t) => t -> String show4 :: t -> String show4 = PadOption -> t -> String forall t. ShowPadded t => PadOption -> t -> String showPaddedNum (PadOption -> t -> String) -> PadOption -> t -> String forall a b. (a -> b) -> a -> b $ Int -> Char -> PadOption Pad Int 4 Char '0' mod100 :: (Integral i) => i -> i mod100 :: i -> i mod100 i x = i -> i -> i forall a. Integral a => a -> a -> a mod i x i 100 div100 :: (Integral i) => i -> i div100 :: i -> i div100 i x = i -> i -> i forall a. Integral a => a -> a -> a div i x i 100 clip :: (Ord t) => t -> t -> t -> t clip :: t -> t -> t -> t clip t a t _ t x | t x t -> t -> Bool forall a. Ord a => a -> a -> Bool < t a = t a clip t _ t b t x | t x t -> t -> Bool forall a. Ord a => a -> a -> Bool > t b = t b clip t _ t _ t x = t x clipValid :: (Ord t) => t -> t -> t -> Maybe t clipValid :: t -> t -> t -> Maybe t clipValid t a t _ t x | t x t -> t -> Bool forall a. Ord a => a -> a -> Bool < t a = Maybe t forall a. Maybe a Nothing clipValid t _ t b t x | t x t -> t -> Bool forall a. Ord a => a -> a -> Bool > t b = Maybe t forall a. Maybe a Nothing clipValid t _ t _ t x = t -> Maybe t forall a. a -> Maybe a Just t x quotBy :: (Real a, Integral b) => a -> a -> b quotBy :: a -> a -> b quotBy a d a n = Rational -> b forall a b. (RealFrac a, Integral b) => a -> b truncate ((a -> Rational forall a. Real a => a -> Rational toRational a n) Rational -> Rational -> Rational forall a. Fractional a => a -> a -> a / (a -> Rational forall a. Real a => a -> Rational toRational a d)) remBy :: Real a => a -> a -> a remBy :: a -> a -> a remBy a d a n = a n a -> a -> a forall a. Num a => a -> a -> a - (Integer -> a forall a. Num a => Integer -> a fromInteger Integer f) a -> a -> a forall a. Num a => a -> a -> a * a d where f :: Integer f = a -> a -> Integer forall a b. (Real a, Integral b) => a -> a -> b quotBy a d a n quotRemBy :: (Real a, Integral b) => a -> a -> (b, a) quotRemBy :: a -> a -> (b, a) quotRemBy a d a n = let f :: b f = a -> a -> b forall a b. (Real a, Integral b) => a -> a -> b quotBy a d a n in (b f, a n a -> a -> a forall a. Num a => a -> a -> a - (b -> a forall a b. (Integral a, Num b) => a -> b fromIntegral b f) a -> a -> a forall a. Num a => a -> a -> a * a d)