packages feed

thyme 0.1.1.0 → 0.1.1.1

raw patch · 9 files changed

+229/−65 lines, 9 files

Files

Data/Micro.hs view
@@ -77,11 +77,6 @@ microQuotRem (Micro a) (Micro b) = (n, Micro f) where     (n, f) = quotRem a b --- for when we'd rather not depend on RealFrac-{-# INLINE microTruncate #-}-microTruncate :: Micro -> Int-microTruncate a = fromIntegral . fst . microQuotRem a $ Micro 1000000- instance AdditiveGroup Micro where     {-# INLINE zeroV #-}     zeroV = Micro 0
Data/Thyme/Calendar.hs view
@@ -21,21 +21,25 @@ import Data.Thyme.Format.Internal import Data.Thyme.TH -{-# INLINE gregorian #-}-gregorian :: Simple Iso Day YearMonthDay-gregorian = ordinalDate . iso fromOrdinal toOrdinal where+{-# INLINE yearMonthDay #-}+yearMonthDay :: Simple Iso OrdinalDate YearMonthDay+yearMonthDay = iso fromOrdinal toOrdinal where -    {-# INLINE fromOrdinal #-}+    {-# INLINEABLE fromOrdinal #-}     fromOrdinal :: OrdinalDate -> YearMonthDay     fromOrdinal (OrdinalDate y yd) = (YearMonthDay y m d) where         MonthDay m d = view (monthDay (isLeapYear y)) yd -    {-# INLINE toOrdinal #-}+    {-# INLINEABLE toOrdinal #-}     toOrdinal :: YearMonthDay -> OrdinalDate     toOrdinal (YearMonthDay y m d) = OrdinalDate y $         review (monthDay (isLeapYear y)) (MonthDay m d) -{-# INLINE fromGregorianValid #-}+{-# INLINE gregorian #-}+gregorian :: Simple Iso Day YearMonthDay+gregorian = ordinalDate . yearMonthDay++{-# INLINEABLE fromGregorianValid #-} fromGregorianValid :: YearMonthDay -> Maybe Day fromGregorianValid (YearMonthDay y m d) = review ordinalDate . OrdinalDate y     <$> monthDayToDayOfYearValid (isLeapYear y) (MonthDay m d)
Data/Thyme/Calendar/Internal.hs view
@@ -92,17 +92,17 @@  ------------------------------------------------------------------------ -type Week = Int+type WeekOfYear = Int type DayOfWeek = Int data WeekDate = WeekDate     { wdYear :: {-# UNPACK #-}!Year-    , wdWeek :: {-# UNPACK #-}!Week+    , wdWeek :: {-# UNPACK #-}!WeekOfYear     , wdDay :: {-# UNPACK #-}!DayOfWeek     } deriving (Eq, Ord, Data, Typeable, Show)  instance NFData WeekDate --- | Accepts 0-based 'DayOfWeek' and 'Week' when 'review'ing.+-- | Accepts 0-based 'DayOfWeek' and 'WeekOfYear' when 'review'ing. {-# INLINE weekDate #-} weekDate :: Simple Iso Day WeekDate weekDate = iso toWeek fromWeek where@@ -114,9 +114,9 @@         -- pilfered and refactored; no idea what foo and bar mean         OrdinalDate y0 yd = view ordinalDate day         d = mjd + 2-        foo :: Year -> {-Week-1-}Int64+        foo :: Year -> {-WeekOfYear-1-}Int64         foo y = bar $ review ordinalDate (OrdinalDate y 6)-        bar :: Day -> {-Week-1-}Int64+        bar :: Day -> {-WeekOfYear-1-}Int64         bar (ModifiedJulianDay k) = div d 7 - div k 7         w0 = bar $ ModifiedJulianDay (d - fromIntegral yd + 4)         (y1, w1) = case w0 of@@ -130,7 +130,7 @@         WeekDate _ wMax _ = toWeek $ review ordinalDate (OrdinalDate y 365)  {-# INLINE fromWeekMax #-}-fromWeekMax :: Week -> WeekDate -> Day+fromWeekMax :: WeekOfYear -> WeekDate -> Day fromWeekMax wMax (WeekDate y w d) = ModifiedJulianDay mjd where     -- pilfered and refactored     ModifiedJulianDay k = review ordinalDate (OrdinalDate y 6)
Data/Thyme/Calendar/MonthDay.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} +-- | Julian or Gregorian. module Data.Thyme.Calendar.MonthDay     ( Month, DayOfMonth     , module Data.Thyme.Calendar.MonthDay
Data/Thyme/Calendar/OrdinalDate.hs view
@@ -29,7 +29,7 @@     d = mjd + 3     k = d - fromIntegral yd --- | Accepts 0−6 for 'DayOfWeek', and 0-based 'Week's.+-- | Accepts 0−6 for 'DayOfWeek', and 0-based 'WeekOfYear's. {-# INLINEABLE fromSundayStartWeekValid #-} fromSundayStartWeekValid :: WeekDate -> Maybe Day fromSundayStartWeekValid wd@(WeekDate y w d) = fromWeekMax wMax wd@@ -45,7 +45,7 @@     d = mjd + 2     k = d - fromIntegral yd --- | Accepts 1−7 for 'DayOfWeek', and 0-based 'Week's.+-- | Accepts 1−7 for 'DayOfWeek', and 0-based 'WeekOfYear's. {-# INLINEABLE fromMondayStartWeekValid #-} fromMondayStartWeekValid :: WeekDate -> Maybe Day fromMondayStartWeekValid wd@(WeekDate y w d) = fromWeekMax wMax wd
Data/Thyme/Calendar/WeekDate.hs view
@@ -3,7 +3,7 @@  -- | ISO 8601 Week Date format module Data.Thyme.Calendar.WeekDate-    ( Year, Week, DayOfWeek+    ( Year, WeekOfYear, DayOfWeek     , WeekDate (..), weekDate     , module Data.Thyme.Calendar.WeekDate     ) where@@ -17,7 +17,7 @@ import Data.Thyme.TH import Text.Printf --- | Rejects 0-based 'DayOfWeek' and 'Week'.+-- | Rejects 0-based 'DayOfWeek' and 'WeekOfYear'. {-# INLINEABLE fromWeekDateValid #-} fromWeekDateValid :: WeekDate -> Maybe Day fromWeekDateValid wd@(WeekDate y w d) = fromWeekMax wMax wd
+ Data/Thyme/Format.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.Thyme.Format+    ( FormatTime (..)+    , formatTime+    ) where++import Prelude+import Control.Applicative+import Control.Lens+import Data.Char+import Data.Int+import Data.Micro+import Data.Thyme.Calendar+import Data.Thyme.Calendar.OrdinalDate+import Data.Thyme.Calendar.WeekDate+import Data.Thyme.Calendar.MonthDay+import Data.Thyme.Clock.POSIX+import Data.Thyme.Clock.Scale+import Data.Thyme.Clock.UTC+import Data.Thyme.LocalTime+import Data.Thyme.Format.Internal+import System.Locale++class FormatTime t where+    showsTime :: TimeLocale -> t -> (Char -> ShowS) -> (Char -> ShowS)++{-# INLINEABLE formatTime #-}+formatTime :: (FormatTime t) => TimeLocale -> String -> t -> String+formatTime l@TimeLocale {..} spec t = go spec "" where+    -- leave unrecognised codes as they are+    format = showsTime l t (\ c s -> '%' : c : s)+    go s = case s of+        '%' : c : rest -> case c of+            -- aggregate+            'c' -> go (dateTimeFmt ++ rest)+            'r' -> go (time12Fmt ++ rest)+            'X' -> go (timeFmt ++ rest)+            'x' -> go (dateFmt ++ rest)+            -- modifier (whatever)+            '-' -> go ('%' : rest)+            '_' -> go ('%' : rest)+            '0' -> go ('%' : rest)+            '^' -> go ('%' : rest)+            '#' -> go ('%' : rest)+            -- escape (why would anyone need %t and %n?)+            '%' -> (:) '%' . go rest+            -- default+            _ -> format c . go rest+        c : rest -> (:) c . go rest+        [] -> id++instance FormatTime TimeOfDay where+    {-# INLINEABLE showsTime #-}+    showsTime TimeLocale {..} (TimeOfDay h m (DiffTime s)) = \ def c -> case c of+        -- aggregate+        'R' -> shows02 h . (:) ':' . shows02 m+        'T' -> shows02 h . (:) ':' . shows02 m . (:) ':' . shows02 si+        -- AM/PM+        'P' -> (++) $ toLower <$> if h < 12 then fst amPm else snd amPm+        'p' -> (++) $ if h < 12 then fst amPm else snd amPm+        -- Hour+        'H' -> shows02 h+        'I' -> shows02 $ 1 + mod (h - 1) 12+        'k' -> shows_2 h+        'l' -> shows_2 $ 1 + mod (h - 1) 12+        -- Minute+        'M' -> shows02 m+        -- Second+        'S' -> shows02 si+        'q' -> fills06 su . shows su+        'Q' -> if su == 0 then id else (:) '.' . fills06 su . drop0 su+        -- default+        _ -> def c++        where+        (fromIntegral -> si, Micro su) = microQuotRem s (Micro 1000000)++        {-# INLINE fills06 #-}+        fills06 :: Int64 -> ShowS+        fills06 n = case () of+            _ | n < 10 -> (:) '0' . (:) '0' . (:) '0' . (:) '0' . (:) '0'+            _ | n < 100 -> (:) '0' . (:) '0' . (:) '0' . (:) '0'+            _ | n < 1000 -> (:) '0' . (:) '0' . (:) '0'+            _ | n < 10000 -> (:) '0' . (:) '0'+            _ | n < 100000 -> (:) '0'+            _ -> id++        {-# INLINE drop0 #-}+        drop0 :: Int64 -> ShowS+        drop0 n = case divMod n 10 of+            (q, 0) -> drop0 q+            _ -> shows n++instance FormatTime YearMonthDay where+    {-# INLINEABLE showsTime #-}+    showsTime TimeLocale {..} (YearMonthDay y m d) = \ def c -> case c of+        -- aggregate+        'D' -> shows02 m . (:) '/' . shows02 d . (:) '/' . shows02 (mod y 100)+        'F' -> shows04 y . (:) '-' . shows02 m . (:) '-' . shows02 d+        -- Year+        'Y' -> shows04 y+        'y' -> shows02 (mod y 100)+        'C' -> shows02 (div y 100)+        -- Month+        'B' -> (++) . fst $ months !! (m - 1)+        'b' -> (++) . snd $ months !! (m - 1)+        'h' -> (++) . snd $ months !! (m - 1)+        'm' -> shows02 m+        -- DayOfMonth+        'd' -> shows02 d+        'e' -> shows_2 d+        -- default+        _ -> def c++instance FormatTime MonthDay where+    {-# INLINEABLE showsTime #-}+    showsTime TimeLocale {..} (MonthDay m d) = \ def c -> case c of+        -- Month+        'B' -> (++) . fst $ months !! (m - 1)+        'b' -> (++) . snd $ months !! (m - 1)+        'h' -> (++) . snd $ months !! (m - 1)+        'm' -> shows02 m+        -- DayOfMonth+        'd' -> shows02 d+        'e' -> shows_2 d+        -- default+        _ -> def c++instance FormatTime OrdinalDate where+    {-# INLINEABLE showsTime #-}+    showsTime TimeLocale {..} (OrdinalDate y d) = \ def c -> case c of+        -- Year+        'Y' -> shows04 y+        'y' -> shows02 (mod y 100)+        'C' -> shows02 (div y 100)+        -- DayOfYear+        'j' -> shows03 d+        -- default+        _ -> def c++instance FormatTime WeekDate where+    {-# INLINEABLE showsTime #-}+    showsTime TimeLocale {..} (WeekDate y w d) = \ def c -> case c of+        -- Year+        'G' -> shows04 y+        'g' -> shows02 (mod y 100)+        'f' -> shows02 (div y 100)+        -- WeekOfYear+        'V' -> shows02 w+        -- DayOfWeek+        'u' -> shows d+        'A' -> (++) . fst $ wDays !! mod d 7+        'a' -> (++) . snd $ wDays !! mod d 7+        'w' -> shows (mod d 7)+        -- default+        _ -> def c++instance FormatTime LocalTime where+    {-# INLINEABLE showsTime #-}+    showsTime l (LocalTime day tod) = showsTime l day . showsTime l tod++instance FormatTime Day where+    {-# INLINEABLE showsTime #-}+    showsTime l d = showsTime l ordinal+            . showsTime l (view yearMonthDay ordinal)+            . showsTime l (view weekDate d) . other where+        ordinal = view ordinalDate d+        other :: (Char -> ShowS) -> (Char -> ShowS)+        other def c = case c of+            -- Non-standard WeekOfYear+            'U' -> shows02 . wdWeek $ sundayStartWeek d+            'W' -> shows02 . wdWeek $ mondayStartWeek d+            -- default+            _ -> def c++instance FormatTime TimeZone where+    {-# INLINEABLE showsTime #-}+    showsTime _ tz@(TimeZone _ _ name) = \ def c -> case c of+        'z' -> (++) (timeZoneOffsetString tz)+        'Z' -> (++) (if null name then timeZoneOffsetString tz else name)+        _ -> def c++instance FormatTime ZonedTime where+    {-# INLINEABLE showsTime #-}+    showsTime l (ZonedTime lt tz) = showsTime l lt . showsTime l tz++instance FormatTime UTCTime where+    {-# INLINEABLE showsTime #-}+    showsTime l t = \ def c -> case c of+        's' -> shows . fst $ microQuotRem s (Micro 1000000)+        _ -> showsTime l (view zonedTime (utc, t)) def c+      where+        NominalDiffTime s = view posixTime t+
Data/Thyme/Format/Internal.hs view
@@ -1,26 +1,21 @@ module Data.Thyme.Format.Internal where  import Prelude-import Data.Micro  {-# INLINE shows02 #-} shows02 :: Int -> String -> String shows02 n = if n < 10 then (:) '0' . shows n else shows n -{-# INLINE show02 #-}-show02 :: Int -> String-show02 n = if n < 10 then '0' : show n else show n--{-# INLINE show_2 #-}-show_2 :: Int -> String-show_2 n = if n < 10 then ' ' : show n else show n+{-# INLINE shows_2 #-}+shows_2 :: Int -> String -> String+shows_2 n = if n < 10 then (:) ' ' . shows n else shows n -{-# INLINE show03 #-}-show03 :: Int -> String-show03 n = case () of-    _ | n < 10 -> '0' : '0' : show n-    _ | n < 100 -> '0' : show n-    _ -> show n+{-# INLINE shows03 #-}+shows03 :: Int -> ShowS+shows03 n = case () of+    _ | n < 10 -> (:) '0' . (:) '0' . shows n+    _ | n < 100 -> (:) '0' . shows n+    _ -> shows n  {-# INLINE shows04 #-} shows04 :: Int -> String -> String@@ -29,33 +24,4 @@     _ | n < 100 -> (:) '0' . (:) '0' . shows n     _ | n < 1000 -> (:) '0' . shows n     _ -> shows n--{-# INLINE show04 #-}-show04 :: Int -> String-show04 n = shows04 n ""--{-# INLINE show60 #-}-show60 :: Micro -> String-show60 (Micro u) = case () of-    _ | u < 10 -> '0' : '0' : '0' : '0' : '0' : show u-    _ | u < 100 -> '0' : '0' : '0' : '0' : show u-    _ | u < 1000 -> '0' : '0' : '0' : show u-    _ | u < 10000 -> '0' : '0' : show u-    _ | u < 100000 -> '0' : show u-    _ -> show u--{-# INLINE show6 #-}-show6 :: Micro -> String-show6 (Micro u) = case () of-    _ | u == 0 -> ""-    _ | u < 10 -> '.' : '0' : '0' : '0' : '0' : '0' : shrink u-    _ | u < 100 -> '.' : '0' : '0' : '0' : '0' : shrink u-    _ | u < 1000 -> '.' : '0' : '0' : '0' : shrink u-    _ | u < 10000 -> '.' : '0' : '0' : shrink u-    _ | u < 100000 -> '.' : '0' : shrink u-    _ -> '.' : shrink u-  where-    shrink v = case divMod v 10 of-        (w, 0) -> shrink w-        _ -> show v
thyme.cabal view
@@ -1,5 +1,5 @@ name:           thyme-version:        0.1.1.0+version:        0.1.1.1 synopsis:       A faster time library description:     A faster time library@@ -35,6 +35,7 @@         Data.Thyme.Calendar.WeekDate         Data.Thyme.Clock         Data.Thyme.Clock.POSIX+        Data.Thyme.Format         Data.Thyme.LocalTime     other-modules:         Data.Micro