Hello community,
here is the log from the commit of package wicked for openSUSE:13.2:Update checked in at 2016-02-29 20:11:18
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:13.2:Update/wicked (Old)
and /work/SRC/openSUSE:13.2:Update/.wicked.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "wicked"
Changes:
--------
New Changes file:
NO CHANGES FILE!!!
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ _link ++++++
--- /var/tmp/diff_new_pack.Rgw4iG/_old 2016-02-29 20:11:22.000000000 +0100
+++ /var/tmp/diff_new_pack.Rgw4iG/_new 2016-02-29 20:11:22.000000000 +0100
@@ -1 +1 @@
-<link package='wicked.4608' cicount='copy' />
+<link package='wicked.4730' cicount='copy' />
Hello community,
here is the log from the commit of package ghc-hourglass for openSUSE:Factory checked in at 2016-02-29 09:14:45
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-hourglass (Old)
and /work/SRC/openSUSE:Factory/.ghc-hourglass.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hourglass"
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-hourglass/ghc-hourglass.changes 2015-05-27 12:43:12.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-hourglass.new/ghc-hourglass.changes 2016-02-29 09:16:14.000000000 +0100
@@ -1,0 +2,5 @@
+Sun Feb 28 21:48:31 UTC 2016 - mimi.vx(a)gmail.com
+
+- update to 0.2.10
+
+-------------------------------------------------------------------
Old:
----
hourglass-0.2.9.tar.gz
New:
----
hourglass-0.2.10.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-hourglass.spec ++++++
--- /var/tmp/diff_new_pack.o6ZMiG/_old 2016-02-29 09:16:16.000000000 +0100
+++ /var/tmp/diff_new_pack.o6ZMiG/_new 2016-02-29 09:16:16.000000000 +0100
@@ -20,7 +20,7 @@
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.2.9
+Version: 0.2.10
Release: 0
Summary: Simple performant time related library
Group: System/Libraries
++++++ hourglass-0.2.9.tar.gz -> hourglass-0.2.10.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/Data/Hourglass/Compat.hs new/hourglass-0.2.10/Data/Hourglass/Compat.hs
--- old/hourglass-0.2.9/Data/Hourglass/Compat.hs 2015-04-01 16:53:50.000000000 +0200
+++ new/hourglass-0.2.10/Data/Hourglass/Compat.hs 2016-02-27 12:23:51.000000000 +0100
@@ -29,76 +29,10 @@
-- >
-- > offsetTime = H.TimezoneOffset $ fromIntegral $ T.timeZoneMinutes $ T.zonedTimeZone oldTime
--
+-- This module will be depreciated in favor of Time.Compat
+--
module Data.Hourglass.Compat
- ( dateFromPOSIXEpoch
- , dateFromTAIEpoch
- , diffTimeToTimeOfDay
+ ( module Time.Compat
) where
-import Data.Hourglass
-
--- | Convert an integer which represent the Number of days (To/From) POSIX Epoch
--- to a Date (POSIX Epoch is 1970-01-01).
-dateFromPOSIXEpoch :: Integer -- ^ number of days since POSIX Epoch
- -> Date
-dateFromPOSIXEpoch day = do
- let sec = Elapsed $ fromIntegral $ day * 86400
- timeConvert sec
-
--- | Number of days between POSIX Epoch and TAI Epoch
--- (between 1858-11-17 and 1970-01-01)
-daysTAItoPOSIX :: Integer
-daysTAItoPOSIX = 40587
-
--- | Convert an integer which represents the Number of days (To/From) TAI Epoch
--- This function allows use of the package time to easily convert the Day into
--- the Hourglass Date representation (TAI Epoch is 1858-11-17).
---
--- This function allows user to easily convert a Data.Time.Calendar.Day into Date
---
--- > import qualified Data.Time.Calendar as T
--- >
--- > timeDay :: T.Day
--- >
--- > dateFromTAIEpoch $ T.toModifiedJulianDay timeDay
-dateFromTAIEpoch :: Integer -- ^ number of days since TAI Epoch
- -> Date
-dateFromTAIEpoch dtai =
- dateFromPOSIXEpoch (dtai - daysTAItoPOSIX)
-
--- | Convert of differential of time of a day.
--- (it convers a Data.Time.Clock.DiffTime into a TimeOfDay)
---
--- Example with DiffTime type from time:
---
--- > import qualified Data.Time.Clock as T
--- >
--- > difftime :: T.DiffTime
--- >
--- > diffTimeToTimeOfDay difftime
---
--- Example with the TimeOfDay type from time:
---
--- > import qualified Data.Time.Clock as T
--- >
--- > timeofday :: T.TimeOfDay
--- >
--- > diffTimeToTimeOfDay $ T.timeOfDayToTime timeofday
-diffTimeToTimeOfDay :: Real t
- => t -- ^ number of seconds of the time of the day
- -> TimeOfDay
-diffTimeToTimeOfDay dt = do
- TimeOfDay
- { todHour = fromIntegral hours
- , todMin = fromIntegral minutes
- , todSec = fromIntegral seconds
- , todNSec = fromIntegral nsecs
- }
- where
- r :: Rational
- r = toRational dt
- (secs, nR) = properFraction r :: (Integer, Rational)
- nsecs :: Integer
- nsecs = round (nR * 1000000000)
- (minsofday, seconds) = secs `divMod` 60 :: (Integer, Integer)
- (hours, minutes) = minsofday `divMod` 60 :: (Integer, Integer)
+import Time.Compat
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/Data/Hourglass/Diff.hs new/hourglass-0.2.10/Data/Hourglass/Diff.hs
--- old/hourglass-0.2.9/Data/Hourglass/Diff.hs 2015-04-01 16:53:50.000000000 +0200
+++ new/hourglass-0.2.10/Data/Hourglass/Diff.hs 2016-02-27 12:23:51.000000000 +0100
@@ -34,7 +34,7 @@
{ periodYears :: !Int
, periodMonths :: !Int
, periodDays :: !Int
- } deriving (Read,Eq,Ord,Data,Typeable)
+ } deriving (Show,Read,Eq,Ord,Data,Typeable)
instance NFData Period where
rnf (Period y m d) = y `seq` m `seq` d `seq` ()
@@ -50,7 +50,7 @@
, durationMinutes :: !Minutes -- ^ number of minutes
, durationSeconds :: !Seconds -- ^ number of seconds
, durationNs :: !NanoSeconds -- ^ number of nanoseconds
- } deriving (Read,Eq,Ord,Data,Typeable)
+ } deriving (Show,Read,Eq,Ord,Data,Typeable)
instance NFData Duration where
rnf (Duration h m s ns) = h `seq` m `seq` s `seq` ns `seq` ()
@@ -86,10 +86,16 @@
where
(yDiffAcc,mStartPos) = (fromEnum mOrig + mDiff) `divMod` 12
loop y m d
- | d < dMonth = Date y (toEnum m) d
+ | d <= 0 =
+ let (m', y') = if m == 0
+ then (11, y - 1)
+ else (m - 1, y)
+ in
+ loop y' m' (daysInMonth y' (toEnum m') + d)
+ | d <= dMonth = Date y (toEnum m) d
| otherwise =
let newDiff = d - dMonth
- in if m == 12
+ in if m == 11
then loop (y+1) 0 newDiff
else loop y (m+1) newDiff
where dMonth = daysInMonth y (toEnum m)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/Data/Hourglass/Internal/Win.hs new/hourglass-0.2.10/Data/Hourglass/Internal/Win.hs
--- old/hourglass-0.2.9/Data/Hourglass/Internal/Win.hs 2015-04-01 16:53:50.000000000 +0200
+++ new/hourglass-0.2.10/Data/Hourglass/Internal/Win.hs 2016-02-27 12:23:51.000000000 +0100
@@ -61,9 +61,16 @@
systemGetTimezone :: IO TimezoneOffset
systemGetTimezone = do
- (_,tzInfo) <- getTimeZoneInformation
- return $ TimezoneOffset $ getTzOffset tzInfo
- where getTzOffset tzInfo = fromIntegral (tziBias tzInfo - tziDaylightBias tzInfo)
+ (tzMode,tzInfo) <- getTimeZoneInformation
+ case tzMode of
+ TzIdDaylight -> return $ toTO (tziBias tzInfo + tziDaylightBias tzInfo)
+ TzIdStandard -> return $ toTO (tziBias tzInfo + tziStandardBias tzInfo)
+ TzIdUnknown -> return $ toTO (tziBias tzInfo)
+ where
+ -- a negative value represent value how to go from local to UTC,
+ -- whereas TimezoneOffset represent the offset to go from UTC to local.
+ -- here we negate the bias to get the proper value represented.
+ toTO = TimezoneOffset . fromIntegral . negate
systemGetElapsedP :: IO ElapsedP
systemGetElapsedP = toElapsedP `fmap` getSystemTimeAsFileTime
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/Data/Hourglass/Types.hs new/hourglass-0.2.10/Data/Hourglass/Types.hs
--- old/hourglass-0.2.9/Data/Hourglass/Types.hs 2015-04-01 16:53:50.000000000 +0200
+++ new/hourglass-0.2.10/Data/Hourglass/Types.hs 2016-02-27 12:23:51.000000000 +0100
@@ -14,226 +14,10 @@
-- Most units use the unix epoch referential, but by no means reduce portability.
-- the unix referential works under the Windows platform or any other platforms.
--
+-- This module will be depreciated in favor of Time.Types
+--
module Data.Hourglass.Types
- (
- -- * Time units
- NanoSeconds(..)
- , Seconds(..)
- , Minutes(..)
- , Hours(..)
- , TimeInterval(..)
- -- * Time enumeration
- , Month(..)
- , WeekDay(..)
- -- * Timezone
- , TimezoneOffset(..)
- , timezoneOffsetToSeconds
- , timezone_UTC
- -- * Computer friendly format
- -- ** Unix elapsed
- , Elapsed(..)
- , ElapsedP(..)
- -- * Human friendly format
- -- ** Calendar time
- , Date(..)
- , TimeOfDay(..)
- , DateTime(..)
+ ( module Time.Types
) where
-import Data.Int
-import Data.Data
-import Data.Ratio
-import Control.DeepSeq
-import Data.Hourglass.Utils (pad2)
-
--- | Represent any time interval that has an
--- equivalent value to a number of seconds.
-class TimeInterval i where
- toSeconds :: i -> Seconds
- fromSeconds :: Seconds -> (i, Seconds)
-
--- | Nanoseconds
-newtype NanoSeconds = NanoSeconds Int64
- deriving (Read,Eq,Ord,Num,Data,Typeable,NFData)
-
-instance Show NanoSeconds where
- show (NanoSeconds v) = shows v "ns"
-
-instance TimeInterval NanoSeconds where
- toSeconds (NanoSeconds ns) = Seconds (ns `div` 1000000000)
- fromSeconds (Seconds s) = (NanoSeconds (s * 1000000000), 0)
-
--- | Number of seconds without a referential.
---
--- Can hold a number between [-2^63,2^63-1], which should
--- be good for some billions of years.
---
--- However, because of limitation in the calendar conversion
--- currently used, seconds should be in the range [-2^55,2^55-1],
--- which is good for only 1 billion of year.
-newtype Seconds = Seconds Int64
- deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData)
-
-instance Show Seconds where
- show (Seconds s) = shows s "s"
-
-instance TimeInterval Seconds where
- toSeconds = id
- fromSeconds s = (s,0)
-
--- | Number of minutes without a referential.
-newtype Minutes = Minutes Int64
- deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData)
-
-instance Show Minutes where
- show (Minutes s) = shows s "m"
-
-instance TimeInterval Minutes where
- toSeconds (Minutes m) = Seconds (m * 60)
- fromSeconds (Seconds s) = (Minutes m, Seconds s')
- where (m, s') = s `divMod` 60
-
--- | Number of hours without a referential.
-newtype Hours = Hours Int64
- deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData)
-
-instance Show Hours where
- show (Hours s) = shows s "h"
-
-instance TimeInterval Hours where
- toSeconds (Hours h) = Seconds (h * 3600)
- fromSeconds (Seconds s) = (Hours h, Seconds s')
- where (h, s') = s `divMod` 3600
-
--- | A number of seconds elapsed since the unix epoch.
-newtype Elapsed = Elapsed Seconds
- deriving (Read,Eq,Ord,Num,Data,Typeable,NFData)
-
-instance Show Elapsed where
- show (Elapsed s) = show s
-
--- | A number of seconds and nanoseconds elapsed since the unix epoch.
-data ElapsedP = ElapsedP {-# UNPACK #-} !Elapsed {-# UNPACK #-} !NanoSeconds
- deriving (Read,Eq,Ord,Data,Typeable)
-
-instance Show ElapsedP where
- show (ElapsedP e ns) = shows e ('.' : show ns)
-
-instance NFData ElapsedP where rnf e = e `seq` ()
-
-instance Num ElapsedP where
- (+) = addElapsedP
- (-) = subElapsedP
- (ElapsedP e1 ns1) * (ElapsedP e2 ns2) = ElapsedP (e1*e2) (ns1*ns2)
- negate (ElapsedP e ns) = ElapsedP (negate e) ns
- abs (ElapsedP e ns) = ElapsedP (abs e) ns
- signum (ElapsedP e ns) = ElapsedP (signum e) ns
- fromInteger i = ElapsedP (Elapsed (fromIntegral i)) 0
-
-addElapsedP :: ElapsedP -> ElapsedP -> ElapsedP
-addElapsedP (ElapsedP e1 (NanoSeconds ns1)) (ElapsedP e2 (NanoSeconds ns2)) =
- let notNormalizedNS = ns1 + ns2
- (retainedNS, ns) = notNormalizedNS `divMod` 1000000000
- in ElapsedP (e1 + e2 + (Elapsed $ Seconds retainedNS)) (NanoSeconds ns)
-
-subElapsedP :: ElapsedP -> ElapsedP -> ElapsedP
-subElapsedP (ElapsedP e1 (NanoSeconds ns1)) (ElapsedP e2 (NanoSeconds ns2)) =
- let notNormalizedNS = ns1 - ns2
- notNormalizedS = e1 - e2
- in if notNormalizedNS < 0
- then ElapsedP (notNormalizedS - oneSecond) (NanoSeconds (1000000000 + notNormalizedNS))
- else ElapsedP notNormalizedS (NanoSeconds notNormalizedNS)
- where
- oneSecond :: Elapsed
- oneSecond = Elapsed $ Seconds 1
-
-instance Real ElapsedP where
- -- FIXME
- toRational (ElapsedP (Elapsed (Seconds s)) (NanoSeconds ns)) =
- fromIntegral s + (1000000000 % fromIntegral ns)
-
--- | Month of the year
-data Month =
- January
- | February
- | March
- | April
- | May
- | June
- | July
- | August
- | September
- | October
- | November
- | December
- deriving (Show,Eq,Ord,Enum,Data,Typeable)
-
--- | Day of the week
---
--- the enumeration starts on Sunday.
-data WeekDay =
- Sunday
- | Monday
- | Tuesday
- | Wednesday
- | Thursday
- | Friday
- | Saturday
- deriving (Show,Read,Eq,Ord,Enum,Data,Typeable)
-
--- | Offset against UTC in minutes
---
--- * a positive number represent a location East of UTC.
---
--- * a negative number represent a location West of UTC.
---
--- LocalTime t (-300) = t represent a time at UTC-5
--- LocalTime t (+480) = t represent a time at UTC+8
---
--- should be between -11H and +14H
-newtype TimezoneOffset = TimezoneOffset
- { timezoneOffsetToMinutes :: Int -- ^ return the number of minutes
- } deriving (Eq,Ord,Data,Typeable,NFData)
-
--- | Return the number of seconds associated with a timezone
-timezoneOffsetToSeconds :: TimezoneOffset -> Seconds
-timezoneOffsetToSeconds (TimezoneOffset ofs) = Seconds (fromIntegral ofs * 60)
-
-instance Show TimezoneOffset where
- show (TimezoneOffset tz) =
- concat [if tz < 0 then "-" else "+", pad2 tzH, pad2 tzM]
- where (tzH, tzM) = abs tz `divMod` 60
-
--- | The UTC timezone. offset of 0
-timezone_UTC :: TimezoneOffset
-timezone_UTC = TimezoneOffset 0
-
--- | human date representation using common calendar
-data Date = Date
- { dateYear :: {-# UNPACK #-} !Int -- ^ year (Common Era)
- , dateMonth :: !Month -- ^ month of the year
- , dateDay :: {-# UNPACK #-} !Int -- ^ day of the month, between 1 to 31
- } deriving (Show,Eq,Ord,Data,Typeable)
-
-instance NFData Date where
- rnf (Date y m d) = y `seq` m `seq` d `seq` ()
-
--- | human time representation of hour, minutes, seconds in a day.
-data TimeOfDay = TimeOfDay
- { todHour :: {-# UNPACK #-} !Hours -- ^ hours, between 0 and 23
- , todMin :: {-# UNPACK #-} !Minutes -- ^ minutes, between 0 and 59
- , todSec :: {-# UNPACK #-} !Seconds -- ^ seconds, between 0 and 59. 60 when having leap second */
- , todNSec :: {-# UNPACK #-} !NanoSeconds -- ^ nanoseconds, between 0 and 999999999 */
- } deriving (Show,Eq,Ord,Data,Typeable)
-
-instance NFData TimeOfDay where
- rnf (TimeOfDay h m s ns) = h `seq` m `seq` s `seq` ns `seq` ()
-
--- | Date and Time
-data DateTime = DateTime
- { dtDate :: Date
- , dtTime :: TimeOfDay
- } deriving (Show,Eq,Ord,Data,Typeable)
-
-instance NFData DateTime where
- rnf (DateTime d t) = rnf d `seq` rnf t `seq` ()
+import Time.Types
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/Data/Hourglass.hs new/hourglass-0.2.10/Data/Hourglass.hs
--- old/hourglass-0.2.9/Data/Hourglass.hs 2015-04-01 16:53:50.000000000 +0200
+++ new/hourglass-0.2.10/Data/Hourglass.hs 2016-02-27 12:23:51.000000000 +0100
@@ -37,4 +37,4 @@
import Data.Hourglass.Types
import Data.Hourglass.Local
import Data.Hourglass.Zone
-import Data.Hourglass.Calendar (isLeapYear, getWeekDay, getDayOfTheYear)
+import Data.Hourglass.Calendar (isLeapYear, getWeekDay, getDayOfTheYear, daysInMonth)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/System/Hourglass.hs new/hourglass-0.2.10/System/Hourglass.hs
--- old/hourglass-0.2.9/System/Hourglass.hs 2015-04-01 16:53:50.000000000 +0200
+++ new/hourglass-0.2.10/System/Hourglass.hs 2016-02-27 12:23:51.000000000 +0100
@@ -7,52 +7,10 @@
--
-- Get the system timezone and current time value in multiple formats
--
+-- This module will be depreciated in favor of Time.System
+--
module System.Hourglass
- (
- -- * Current time in computer friendly format
- timeCurrent
- , timeCurrentP
- -- * Current time in human friendly DateTime format
- , dateCurrent
- , localDateCurrent
- , localDateCurrentAt
- -- * System timezone
- , timezoneCurrent
+ ( module Time.System
) where
-import Control.Applicative
-import Data.Hourglass.Types
-import Data.Hourglass.Time
-import Data.Hourglass.Local
-import Data.Hourglass.Internal (systemGetElapsedP, systemGetElapsed, systemGetTimezone)
-
--- | Get the current elapsed seconds since epoch
-timeCurrent :: IO Elapsed
-timeCurrent = systemGetElapsed
-
--- | Get the current elapsed seconds (precise to the nanosecond) since epoch
-timeCurrentP :: IO ElapsedP
-timeCurrentP = systemGetElapsedP
-
--- | Get the current global date
---
--- This is equivalent to:
---
--- > timeGetDateTimeOfDay `fmap` timeCurrentP
-dateCurrent :: IO DateTime
-dateCurrent = timeGetDateTimeOfDay <$> timeCurrentP
-
--- | Get the localized date by using 'timezoneCurrent' and 'dateCurrent'
-localDateCurrent :: IO (LocalTime DateTime)
-localDateCurrent = localTimeSetTimezone <$> timezoneCurrent
- <*> (localTimeFromGlobal <$> dateCurrent)
-
--- | Get the localized date at a specific timezone offset.
-localDateCurrentAt :: TimezoneOffset -> IO (LocalTime DateTime)
-localDateCurrentAt tz = localTimeSetTimezone tz . localTimeFromGlobal <$> dateCurrent
-
--- | Get the current timezone offset
---
--- This include daylight saving time when in operation.
-timezoneCurrent :: IO TimezoneOffset
-timezoneCurrent = systemGetTimezone
+import Time.System
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/Time/Compat.hs new/hourglass-0.2.10/Time/Compat.hs
--- old/hourglass-0.2.9/Time/Compat.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/hourglass-0.2.10/Time/Compat.hs 2016-02-27 12:23:51.000000000 +0100
@@ -0,0 +1,104 @@
+-- |
+-- Module : Time.Compat
+-- License : BSD-style
+-- Maintainer : Nicolas DI PRIMA <nicolas(a)di-prima.fr>
+--
+-- Basic Time conversion compatibility.
+--
+-- This module aims to help conversion between the types from the package
+-- time to the package hourglass.
+--
+-- Example of use (extracted from file Example/Time/Compat.hs):
+--
+-- > import Data.Hourglass as H
+-- > import Data.Hourglass.Compat as C
+-- > import Data.Time as T
+-- >
+-- > transpose :: T.ZonedTime
+-- > -> H.LocalTime H.DateTime
+-- > transpose oldTime =
+-- > H.localTime
+-- > offsetTime
+-- > (H.DateTime newDate timeofday)
+-- > where
+-- > newDate :: H.Date
+-- > newDate = C.dateFromTAIEpoch $ T.toModifiedJulianDay $ T.localDay $ T.zonedTimeToLocalTime oldTime
+-- >
+-- > timeofday :: H.TimeOfDay
+-- > timeofday = C.diffTimeToTimeOfDay $ T.timeOfDayToTime $ T.localTimeOfDay $ T.zonedTimeToLocalTime oldTime
+-- >
+-- > offsetTime = H.TimezoneOffset $ fromIntegral $ T.timeZoneMinutes $ T.zonedTimeZone oldTime
+--
+module Time.Compat
+ ( dateFromPOSIXEpoch
+ , dateFromTAIEpoch
+ , diffTimeToTimeOfDay
+ ) where
+
+import Data.Hourglass
+
+-- | Convert an integer which represent the Number of days (To/From) POSIX Epoch
+-- to a Date (POSIX Epoch is 1970-01-01).
+dateFromPOSIXEpoch :: Integer -- ^ number of days since POSIX Epoch
+ -> Date
+dateFromPOSIXEpoch day = do
+ let sec = Elapsed $ fromIntegral $ day * 86400
+ timeConvert sec
+
+-- | Number of days between POSIX Epoch and TAI Epoch
+-- (between 1858-11-17 and 1970-01-01)
+daysTAItoPOSIX :: Integer
+daysTAItoPOSIX = 40587
+
+-- | Convert an integer which represents the Number of days (To/From) TAI Epoch
+-- This function allows use of the package time to easily convert the Day into
+-- the Hourglass Date representation (TAI Epoch is 1858-11-17).
+--
+-- This function allows user to easily convert a Data.Time.Calendar.Day into Date
+--
+-- > import qualified Data.Time.Calendar as T
+-- >
+-- > timeDay :: T.Day
+-- >
+-- > dateFromTAIEpoch $ T.toModifiedJulianDay timeDay
+dateFromTAIEpoch :: Integer -- ^ number of days since TAI Epoch
+ -> Date
+dateFromTAIEpoch dtai =
+ dateFromPOSIXEpoch (dtai - daysTAItoPOSIX)
+
+-- | Convert of differential of time of a day.
+-- (it convers a Data.Time.Clock.DiffTime into a TimeOfDay)
+--
+-- Example with DiffTime type from time:
+--
+-- > import qualified Data.Time.Clock as T
+-- >
+-- > difftime :: T.DiffTime
+-- >
+-- > diffTimeToTimeOfDay difftime
+--
+-- Example with the TimeOfDay type from time:
+--
+-- > import qualified Data.Time.Clock as T
+-- >
+-- > timeofday :: T.TimeOfDay
+-- >
+-- > diffTimeToTimeOfDay $ T.timeOfDayToTime timeofday
+diffTimeToTimeOfDay :: Real t
+ => t -- ^ number of seconds of the time of the day
+ -> TimeOfDay
+diffTimeToTimeOfDay dt = do
+ TimeOfDay
+ { todHour = fromIntegral hours
+ , todMin = fromIntegral minutes
+ , todSec = fromIntegral seconds
+ , todNSec = fromIntegral nsecs
+ }
+ where
+ r :: Rational
+ r = toRational dt
+ (secs, nR) = properFraction r :: (Integer, Rational)
+ nsecs :: Integer
+ nsecs = round (nR * 1000000000)
+ (minsofday, seconds) = secs `divMod` 60 :: (Integer, Integer)
+ (hours, minutes) = minsofday `divMod` 60 :: (Integer, Integer)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/Time/System.hs new/hourglass-0.2.10/Time/System.hs
--- old/hourglass-0.2.9/Time/System.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/hourglass-0.2.10/Time/System.hs 2016-02-27 12:23:51.000000000 +0100
@@ -0,0 +1,58 @@
+-- |
+-- Module : Time.System
+-- License : BSD-style
+-- Maintainer : Vincent Hanquez <vincent(a)snarc.org>
+-- Stability : experimental
+-- Portability : unknown
+--
+-- Get the system timezone and current time value in multiple formats
+--
+module Time.System
+ (
+ -- * Current time in computer friendly format
+ timeCurrent
+ , timeCurrentP
+ -- * Current time in human friendly DateTime format
+ , dateCurrent
+ , localDateCurrent
+ , localDateCurrentAt
+ -- * System timezone
+ , timezoneCurrent
+ ) where
+
+import Control.Applicative
+import Time.Types
+import Data.Hourglass.Time
+import Data.Hourglass.Local
+import Data.Hourglass.Internal (systemGetElapsedP, systemGetElapsed, systemGetTimezone)
+
+-- | Get the current elapsed seconds since epoch
+timeCurrent :: IO Elapsed
+timeCurrent = systemGetElapsed
+
+-- | Get the current elapsed seconds (precise to the nanosecond) since epoch
+timeCurrentP :: IO ElapsedP
+timeCurrentP = systemGetElapsedP
+
+-- | Get the current global date
+--
+-- This is equivalent to:
+--
+-- > timeGetDateTimeOfDay `fmap` timeCurrentP
+dateCurrent :: IO DateTime
+dateCurrent = timeGetDateTimeOfDay <$> timeCurrentP
+
+-- | Get the localized date by using 'timezoneCurrent' and 'dateCurrent'
+localDateCurrent :: IO (LocalTime DateTime)
+localDateCurrent = localTimeSetTimezone <$> timezoneCurrent
+ <*> (localTimeFromGlobal <$> dateCurrent)
+
+-- | Get the localized date at a specific timezone offset.
+localDateCurrentAt :: TimezoneOffset -> IO (LocalTime DateTime)
+localDateCurrentAt tz = localTimeSetTimezone tz . localTimeFromGlobal <$> dateCurrent
+
+-- | Get the current timezone offset
+--
+-- This include daylight saving time when in operation.
+timezoneCurrent :: IO TimezoneOffset
+timezoneCurrent = systemGetTimezone
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/Time/Types.hs new/hourglass-0.2.10/Time/Types.hs
--- old/hourglass-0.2.9/Time/Types.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/hourglass-0.2.10/Time/Types.hs 2016-02-27 12:23:51.000000000 +0100
@@ -0,0 +1,244 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+-- |
+-- Module : Time.Types
+-- License : BSD-style
+-- Maintainer : Vincent Hanquez <vincent(a)snarc.org>
+--
+-- Basic times units and types.
+--
+-- While pratically some units could hold infinite values, for practical
+-- and efficient purpose they are limited to int64 types for seconds
+-- and int types for years.
+--
+-- Most units use the unix epoch referential, but by no means reduce portability.
+-- the unix referential works under the Windows platform or any other platforms.
+--
+module Time.Types
+ (
+ -- * Time units
+ NanoSeconds(..)
+ , Seconds(..)
+ , Minutes(..)
+ , Hours(..)
+ , TimeInterval(..)
+ -- * Time enumeration
+ , Month(..)
+ , WeekDay(..)
+ -- * Timezone
+ , TimezoneOffset(..)
+ , timezoneOffsetToSeconds
+ , timezone_UTC
+ -- * Computer friendly format
+ -- ** Unix elapsed
+ , Elapsed(..)
+ , ElapsedP(..)
+ -- * Human friendly format
+ -- ** Calendar time
+ , Date(..)
+ , TimeOfDay(..)
+ , DateTime(..)
+ ) where
+
+import Data.Int
+import Data.Data
+import Data.Ratio
+import Control.DeepSeq
+import Data.Hourglass.Utils (pad2)
+
+-- | Represent any time interval that has an
+-- equivalent value to a number of seconds.
+class TimeInterval i where
+ toSeconds :: i -> Seconds
+ fromSeconds :: Seconds -> (i, Seconds)
+
+-- | Nanoseconds
+newtype NanoSeconds = NanoSeconds Int64
+ deriving (Read,Eq,Ord,Num,Data,Typeable,NFData)
+
+instance Show NanoSeconds where
+ show (NanoSeconds v) = shows v "ns"
+
+instance TimeInterval NanoSeconds where
+ toSeconds (NanoSeconds ns) = Seconds (ns `div` 1000000000)
+ fromSeconds (Seconds s) = (NanoSeconds (s * 1000000000), 0)
+
+-- | Number of seconds without a referential.
+--
+-- Can hold a number between [-2^63,2^63-1], which should
+-- be good for some billions of years.
+--
+-- However, because of limitation in the calendar conversion
+-- currently used, seconds should be in the range [-2^55,2^55-1],
+-- which is good for only 1 billion of year.
+newtype Seconds = Seconds Int64
+ deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData)
+
+instance Show Seconds where
+ show (Seconds s) = shows s "s"
+
+instance TimeInterval Seconds where
+ toSeconds = id
+ fromSeconds s = (s,0)
+
+-- | Number of minutes without a referential.
+newtype Minutes = Minutes Int64
+ deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData)
+
+instance Show Minutes where
+ show (Minutes s) = shows s "m"
+
+instance TimeInterval Minutes where
+ toSeconds (Minutes m) = Seconds (m * 60)
+ fromSeconds (Seconds s) = (Minutes m, Seconds s')
+ where (m, s') = s `divMod` 60
+
+-- | Number of hours without a referential.
+newtype Hours = Hours Int64
+ deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData)
+
+instance Show Hours where
+ show (Hours s) = shows s "h"
+
+instance TimeInterval Hours where
+ toSeconds (Hours h) = Seconds (h * 3600)
+ fromSeconds (Seconds s) = (Hours h, Seconds s')
+ where (h, s') = s `divMod` 3600
+
+-- | A number of seconds elapsed since the unix epoch.
+newtype Elapsed = Elapsed Seconds
+ deriving (Read,Eq,Ord,Num,Data,Typeable,NFData)
+
+instance Show Elapsed where
+ show (Elapsed s) = show s
+
+-- | A number of seconds and nanoseconds elapsed since the unix epoch.
+data ElapsedP = ElapsedP {-# UNPACK #-} !Elapsed {-# UNPACK #-} !NanoSeconds
+ deriving (Read,Eq,Ord,Data,Typeable)
+
+instance Show ElapsedP where
+ show (ElapsedP e ns) = shows e ('.' : show ns)
+
+instance NFData ElapsedP where rnf e = e `seq` ()
+
+instance Num ElapsedP where
+ (+) = addElapsedP
+ (-) = subElapsedP
+ (ElapsedP e1 ns1) * (ElapsedP e2 ns2) = ElapsedP (e1*e2) (ns1*ns2)
+ negate (ElapsedP e ns) = ElapsedP (negate e) ns
+ abs (ElapsedP e ns) = ElapsedP (abs e) ns
+ signum (ElapsedP e ns) = ElapsedP (signum e) ns
+ fromInteger i = ElapsedP (Elapsed (fromIntegral i)) 0
+
+addElapsedP :: ElapsedP -> ElapsedP -> ElapsedP
+addElapsedP (ElapsedP e1 (NanoSeconds ns1)) (ElapsedP e2 (NanoSeconds ns2)) =
+ let notNormalizedNS = ns1 + ns2
+ (retainedNS, ns) = notNormalizedNS `divMod` 1000000000
+ in ElapsedP (e1 + e2 + (Elapsed $ Seconds retainedNS)) (NanoSeconds ns)
+
+subElapsedP :: ElapsedP -> ElapsedP -> ElapsedP
+subElapsedP (ElapsedP e1 (NanoSeconds ns1)) (ElapsedP e2 (NanoSeconds ns2)) =
+ let notNormalizedNS = ns1 - ns2
+ notNormalizedS = e1 - e2
+ in if notNormalizedNS < 0
+ then ElapsedP (notNormalizedS - oneSecond) (NanoSeconds (1000000000 + notNormalizedNS))
+ else ElapsedP notNormalizedS (NanoSeconds notNormalizedNS)
+ where
+ oneSecond :: Elapsed
+ oneSecond = Elapsed $ Seconds 1
+
+instance Real ElapsedP where
+ -- FIXME
+ toRational (ElapsedP (Elapsed (Seconds s)) (NanoSeconds ns)) =
+ fromIntegral s + (1000000000 % fromIntegral ns)
+
+-- | Month of the year
+data Month =
+ January
+ | February
+ | March
+ | April
+ | May
+ | June
+ | July
+ | August
+ | September
+ | October
+ | November
+ | December
+ deriving (Show,Read,Eq,Ord,Enum,Data,Typeable,Bounded)
+
+-- | Day of the week
+--
+-- the enumeration starts on Sunday.
+data WeekDay =
+ Sunday
+ | Monday
+ | Tuesday
+ | Wednesday
+ | Thursday
+ | Friday
+ | Saturday
+ deriving (Show,Read,Eq,Ord,Enum,Data,Typeable,Bounded)
+
+-- | Offset against UTC in minutes to obtain from UTC time, local time.
+--
+-- * a positive number represent a location East of UTC.
+--
+-- * a negative number represent a location West of UTC.
+--
+-- LocalTime t (-300) = t represent a time at UTC-5
+-- LocalTime t (+480) = t represent a time at UTC+8
+--
+-- should be between -11H and +14H
+--
+-- Example:
+-- in AUSEDT (UTC+1000 with daylight = UTC+1100), local time is 15:47;
+-- Thus, UTC time is 04:47, and TimezoneOffset is +660 (minutes)
+--
+newtype TimezoneOffset = TimezoneOffset
+ { timezoneOffsetToMinutes :: Int -- ^ return the number of minutes
+ } deriving (Eq,Ord,Data,Typeable,NFData)
+
+-- | Return the number of seconds associated with a timezone
+timezoneOffsetToSeconds :: TimezoneOffset -> Seconds
+timezoneOffsetToSeconds (TimezoneOffset ofs) = Seconds (fromIntegral ofs * 60)
+
+instance Show TimezoneOffset where
+ show (TimezoneOffset tz) =
+ concat [if tz < 0 then "-" else "+", pad2 tzH, pad2 tzM]
+ where (tzH, tzM) = abs tz `divMod` 60
+
+-- | The UTC timezone. offset of 0
+timezone_UTC :: TimezoneOffset
+timezone_UTC = TimezoneOffset 0
+
+-- | human date representation using common calendar
+data Date = Date
+ { dateYear :: {-# UNPACK #-} !Int -- ^ year (Common Era)
+ , dateMonth :: !Month -- ^ month of the year
+ , dateDay :: {-# UNPACK #-} !Int -- ^ day of the month, between 1 to 31
+ } deriving (Show,Read,Eq,Ord,Data,Typeable)
+
+instance NFData Date where
+ rnf (Date y m d) = y `seq` m `seq` d `seq` ()
+
+-- | human time representation of hour, minutes, seconds in a day.
+data TimeOfDay = TimeOfDay
+ { todHour :: {-# UNPACK #-} !Hours -- ^ hours, between 0 and 23
+ , todMin :: {-# UNPACK #-} !Minutes -- ^ minutes, between 0 and 59
+ , todSec :: {-# UNPACK #-} !Seconds -- ^ seconds, between 0 and 59. 60 when having leap second */
+ , todNSec :: {-# UNPACK #-} !NanoSeconds -- ^ nanoseconds, between 0 and 999999999 */
+ } deriving (Show,Read,Eq,Ord,Data,Typeable)
+
+instance NFData TimeOfDay where
+ rnf (TimeOfDay h m s ns) = h `seq` m `seq` s `seq` ns `seq` ()
+
+-- | Date and Time
+data DateTime = DateTime
+ { dtDate :: Date
+ , dtTime :: TimeOfDay
+ } deriving (Show,Read,Eq,Ord,Data,Typeable)
+
+instance NFData DateTime where
+ rnf (DateTime d t) = rnf d `seq` rnf t `seq` ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/hourglass.cabal new/hourglass-0.2.10/hourglass.cabal
--- old/hourglass-0.2.9/hourglass.cabal 2015-04-01 16:53:50.000000000 +0200
+++ new/hourglass-0.2.10/hourglass.cabal 2016-02-27 12:23:51.000000000 +0100
@@ -1,5 +1,5 @@
Name: hourglass
-Version: 0.2.9
+Version: 0.2.10
Synopsis: simple performant time related library
Description:
Simple time library focusing on simple but powerful and performant API
@@ -23,7 +23,10 @@
, tests/TimeDB.hs
Library
- Exposed-modules: Data.Hourglass
+ Exposed-modules: Time.Types
+ , Time.System
+ , Time.Compat
+ , Data.Hourglass
, Data.Hourglass.Types
, Data.Hourglass.Epoch
, Data.Hourglass.Compat
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hourglass-0.2.9/tests/Tests.hs new/hourglass-0.2.10/tests/Tests.hs
--- old/hourglass-0.2.9/tests/Tests.hs 2015-04-01 16:53:50.000000000 +0200
+++ new/hourglass-0.2.10/tests/Tests.hs 2016-02-27 12:23:51.000000000 +0100
@@ -51,6 +51,15 @@
(h' , mi') = dt' `divMod` 60
(DateTime (Date y m d) (TimeOfDay h mi sec _)) = localTimeToGlobal localtime
+-- | The @Date@ type is able to represent some values that aren't actually legal,
+-- specifically dates with a day field outside of the range of dates in the
+-- month. This function validates a @Date@. It is conservative; it only verifies
+-- that the day is less than 31. TODO: It would be nice to tighten this up a
+-- bit. There's a daysInMonth function we could use for this,
+-- but Data.Hourglass.Calendar, but it isn't exposed.
+isValidDate :: Date -> Bool
+isValidDate (Date _ _ d) = d > 0 && d <= 31
+
-- windows native functions to convert time cannot handle time before year 1601
#ifdef WINDOWS
loElapsed = -11644473600 -- ~ year 1601
@@ -183,6 +192,8 @@
(toEnum ((fromEnum m+1) `mod` 12) `eq` m') &&
(if m == December then (y+1) `eq` y' else y `eq` y')
-}
+ , testProperty "dateAddPeriod" $ (\date period ->
+ isValidDate (date `dateAddPeriod` period))
]
, testGroup "formating"
[ testProperty "iso8601 date" $ \(e :: Elapsed) ->
Hello community,
here is the log from the commit of package hlint for openSUSE:Factory checked in at 2016-02-29 09:14:40
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/hlint (Old)
and /work/SRC/openSUSE:Factory/.hlint.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "hlint"
Changes:
--------
--- /work/SRC/openSUSE:Factory/hlint/hlint.changes 2016-02-11 12:37:29.000000000 +0100
+++ /work/SRC/openSUSE:Factory/.hlint.new/hlint.changes 2016-02-29 09:16:11.000000000 +0100
@@ -1,0 +2,8 @@
+Sun Feb 28 21:42:14 UTC 2016 - mimi.vx(a)gmail.com
+
+- update to 1.9.30
+* fix incorrect hints of foldr/foldl on a tuple accumulator
+* add warnings about foldable methods on tuple
+* Put warnings before suggestions in the HTML report
+
+-------------------------------------------------------------------
Old:
----
hlint-1.9.28.tar.gz
New:
----
hlint-1.9.30.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ hlint.spec ++++++
--- /var/tmp/diff_new_pack.ZKYdIr/_old 2016-02-29 09:16:13.000000000 +0100
+++ /var/tmp/diff_new_pack.ZKYdIr/_new 2016-02-29 09:16:13.000000000 +0100
@@ -20,7 +20,7 @@
# no useful debuginfo for Haskell packages without C sources
%global debug_package %{nil}
Name: hlint
-Version: 1.9.28
+Version: 1.9.30
Release: 0
Summary: Source code suggestions
License: BSD-3-Clause
++++++ hlint-1.9.28.tar.gz -> hlint-1.9.30.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hlint-1.9.28/CHANGES.txt new/hlint-1.9.30/CHANGES.txt
--- old/hlint-1.9.28/CHANGES.txt 2016-02-04 09:55:19.000000000 +0100
+++ new/hlint-1.9.30/CHANGES.txt 2016-02-26 21:55:03.000000000 +0100
@@ -1,5 +1,10 @@
Changelog for HLint
+1.9.30
+ #220, fix incorrect hints of foldr/foldl on a tuple accumulator
+1.9.29
+ #219, add warnings about foldable methods on tuple
+ Put warnings before suggestions in the HTML report
1.9.28
#215, spot newtype deriving inside classes
1.9.27
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hlint-1.9.28/data/Default.hs new/hlint-1.9.30/data/Default.hs
--- old/hlint-1.9.28/data/Default.hs 2016-02-04 09:55:19.000000000 +0100
+++ new/hlint-1.9.30/data/Default.hs 2016-02-26 21:55:03.000000000 +0100
@@ -509,6 +509,51 @@
warn "Evaluate" = zip [] [] ==> []
warn "Evaluate" = const x y ==> x
+-- FOLDABLE + TUPLES
+
+warn "Using foldr on tuple" = foldr f z (x,b) ==> f b z
+warn "Using foldr' on tuple" = foldr' f z (x,b) ==> f b z
+warn "Using foldl on tuple" = foldl f z (x,b) ==> f z b
+warn "Using foldl' on tuple" = foldl' f z (x,b) ==> f z b
+warn "Using foldMap on tuple" = foldMap f (x,b) ==> f b
+warn "Using foldr1 on tuple" = foldr1 f (x,b) ==> b
+warn "Using foldl1 on tuple" = foldl1 f (x,b) ==> b
+warn "Using elem on tuple" = elem e (x,b) ==> e == b
+warn "Using fold on tuple" = fold (x,b) ==> b
+warn "Using toList on tuple" = toList (x,b) ==> b
+warn "Using maximum on tuple" = maximum (x,b) ==> b
+warn "Using minimum on tuple" = minimum (x,b) ==> b
+warn "Using sum on tuple" = sum (x,b) ==> b
+warn "Using product on tuple" = product (x,b) ==> b
+warn "Using concat on tuple" = concat (x,b) ==> b
+warn "Using and on tuple" = and (x,b) ==> b
+warn "Using or on tuple" = or (x,b) ==> b
+warn "Using any on tuple" = any f (x,b) ==> f b
+warn "Using all on tuple" = all f (x,b) ==> f b
+
+warn "Using foldr on tuple" = foldr f z (x,y,b) ==> f b z
+warn "Using foldr' on tuple" = foldr' f z (x,y,b) ==> f b z
+warn "Using foldl on tuple" = foldl f z (x,y,b) ==> f z b
+warn "Using foldl' on tuple" = foldl' f z (x,y,b) ==> f z b
+warn "Using foldMap on tuple" = foldMap f (x,y,b) ==> f b
+warn "Using foldr1 on tuple" = foldr1 f (x,y,b) ==> b
+warn "Using foldl1 on tuple" = foldl1 f (x,y,b) ==> b
+warn "Using elem on tuple" = elem e (x,y,b) ==> e == b
+warn "Using fold on tuple" = fold (x,y,b) ==> b
+warn "Using toList on tuple" = toList (x,y,b) ==> b
+warn "Using maximum on tuple" = maximum (x,y,b) ==> b
+warn "Using minimum on tuple" = minimum (x,y,b) ==> b
+warn "Using sum on tuple" = sum (x,y,b) ==> b
+warn "Using product on tuple" = product (x,y,b) ==> b
+warn "Using concat on tuple" = concat (x,y,b) ==> b
+warn "Using and on tuple" = and (x,y,b) ==> b
+warn "Using or on tuple" = or (x,y,b) ==> b
+warn "Using any on tuple" = any f (x,y,b) ==> f b
+warn "Using all on tuple" = all f (x,y,b) ==> f b
+
+warn "Using null on tuple" = null x ==> False where _ = isTuple x
+warn "Using length on tuple" = length x ==> 1 where _ = isTuple x
+
-- COMPLEX
{-
@@ -653,6 +698,7 @@
foo = (\a -> Foo {..}) 1
foo = zipWith SymInfo [0 ..] (repeat ty) -- map (\ x -> SymInfo x ty) [0 ..]
f rec = rec
+mean x = fst $ foldl (\(m, n) x' -> (m+(x'-m)/(n+1),n+1)) (0,0) x
import Prelude \
yes = flip mapM -- Control.Monad.forM
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hlint-1.9.28/hlint.cabal new/hlint-1.9.30/hlint.cabal
--- old/hlint-1.9.28/hlint.cabal 2016-02-04 09:55:19.000000000 +0100
+++ new/hlint-1.9.30/hlint.cabal 2016-02-26 21:55:03.000000000 +0100
@@ -1,7 +1,7 @@
cabal-version: >= 1.8
build-type: Simple
name: hlint
-version: 1.9.28
+version: 1.9.30
license: BSD3
license-file: LICENSE
category: Development
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hlint-1.9.28/src/Report.hs new/hlint-1.9.30/src/Report.hs
--- old/hlint-1.9.28/src/Report.hs 2016-02-04 09:55:19.000000000 +0100
+++ new/hlint-1.9.30/src/Report.hs 2016-02-26 21:55:03.000000000 +0100
@@ -4,7 +4,7 @@
import Idea
import Data.Tuple.Extra
-import Data.List
+import Data.List.Extra
import Data.Maybe
import Data.Version
import System.FilePath
@@ -27,9 +27,9 @@
writeReport dataDir file ideas = writeTemplate dataDir inner file
where
generateIds :: [String] -> [(String,Int)] -- sorted by name
- generateIds = map (head &&& length) . group . sort
- files = generateIds $ map (srcSpanFilename . ideaSpan) ideas
- hints = generateIds $ map hintName ideas
+ generateIds = map (head &&& length) . group -- must be already sorted
+ files = generateIds $ sort $ map (srcSpanFilename . ideaSpan) ideas
+ hints = generateIds $ map hintName $ sortOn (negate . fromEnum . ideaSeverity &&& hintName) ideas
hintName x = show (ideaSeverity x) ++ ": " ++ ideaHint x
inner = [("VERSION",['v' : showVersion version]),("CONTENT",content),
Hello community,
here is the log from the commit of package libwebp for openSUSE:Factory checked in at 2016-02-29 09:13:53
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/libwebp (Old)
and /work/SRC/openSUSE:Factory/.libwebp.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "libwebp"
Changes:
--------
--- /work/SRC/openSUSE:Factory/libwebp/libwebp.changes 2015-12-17 15:52:44.000000000 +0100
+++ /work/SRC/openSUSE:Factory/.libwebp.new/libwebp.changes 2016-02-29 09:15:51.000000000 +0100
@@ -1,0 +2,38 @@
+Fri Feb 12 15:34:04 UTC 2016 - mpluskal(a)suse.com
+
+- Update baselibs.conf
+
+-------------------------------------------------------------------
+Thu Feb 11 15:44:22 UTC 2016 - mpluskal(a)suse.com
+
+- Update to 0.5.0
+ * miscellaneous bug & build fixes (issues #234, #258, #274, #275,
+ #278)
+ * encoder & decoder speed-ups on x86/ARM/MIPS for lossy &
+ lossless
+ + note! YUV->RGB conversion was sped-up, but the results will
+ be slightly different from previous releases
+ * various lossless encoder improvements
+ * gif2webp improvements, -min_size option added
+ * tools fully support input from stdin and output to stdout (issue
+ #168)
+ * New WebPAnimEncoder API for creating animations
+ * New WebPAnimDecoder API for decoding animations
+ * other API changes:
+ + libwebp:
+ WebPPictureSmartARGBToYUVA() (-pre 4 in cwebp)
+ WebPConfig::exact (-exact in cwebp; -alpha_cleanup is now the
+ default)
+ WebPConfig::near_lossless (-near_lossless in cwebp)
+ WebPFree() (free'ing webp allocated memory in other
+ languages)
+ WebPConfigLosslessPreset()
+ WebPMemoryWriterClear()
+ + libwebpdemux: removed experimental fragment related fields
+ and functions
+ + libwebpmux: WebPMuxSetCanvasSize()
+ * new libwebpextras library with some uncommon import functions:
+ WebPImportGray/WebPImportRGB565/WebPImportRGB4444
+- Make building more verbose
+
+-------------------------------------------------------------------
Old:
----
libwebp-0.4.4.tar.gz
libwebp-0.4.4.tar.gz.asc
New:
----
libwebp-0.5.0.tar.gz
libwebp-0.5.0.tar.gz.asc
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ libwebp.spec ++++++
--- /var/tmp/diff_new_pack.qWD5Or/_old 2016-02-29 09:15:52.000000000 +0100
+++ /var/tmp/diff_new_pack.qWD5Or/_new 2016-02-29 09:15:52.000000000 +0100
@@ -17,7 +17,7 @@
Name: libwebp
-Version: 0.4.4
+Version: 0.5.0
Release: 0
Summary: Library and tools for the WebP graphics format
License: BSD-3-Clause
@@ -58,53 +58,66 @@
developers can use WebP to compress, archive and distribute digital
images more efficiently.
-%package -n libwebp5
+%package -n libwebp6
Summary: Library for the WebP graphics format
Group: System/Libraries
-%description -n libwebp5
+%description -n libwebp6
WebP is an image format that does lossy compression of digital
photographic images. WebP consists of a codec based on VP8, and a
container based on RIFF. Webmasters, web developers and browser
developers can use WebP to compress, archive and distribute digital
images more efficiently.
-%package -n libwebpdemux1
+%package -n libwebpdemux2
Summary: Library for extraction of data and images from WebP container files
Group: System/Libraries
-%description -n libwebpdemux1
+%description -n libwebpdemux2
The WebP Demux API enables extraction of images and extended format
data from WebP files. This API currently supports reading of XMP/EXIF
metadata, ICC profile and animated images.
-%package -n libwebpmux1
+%package -n libwebpmux2
Summary: Library for reading/adding data to WebP container files
Group: System/Libraries
-%description -n libwebpmux1
+%description -n libwebpmux2
The WebP Mux API contains methods for adding data to and reading data
from WebP files. This API currently supports XMP/EXIF metadata, ICC
profile and animation.
-%package -n libwebpdecoder1
+%package -n libwebpdecoder2
Summary: Library for decoding WebP graphics format
Group: System/Libraries
-%description -n libwebpdecoder1
+%description -n libwebpdecoder2
WebP is an image format that does lossy compression of digital
photographic images. WebP consists of a codec based on VP8, and a
container based on RIFF. Webmasters, web developers and browser
developers can use WebP to compress, archive and distribute digital
images more efficiently.
+%package -n libwebpextras0
+Summary: Library for decoding WebP graphics format
+Group: System/Libraries
+
+%description -n libwebpextras0
+WebP is an image format that does lossy compression of digital
+photographic images. WebP consists of a codec based on VP8, and a
+container based on RIFF. Webmasters, web developers and browser
+developers can use WebP to compress, archive and distribute digital
+images more efficiently. This package contains shared libraries for less
+common imports - WebPImportGray/WebPImportRGB565/WebPImportRGB4444.
+
%package devel
Summary: Development files for libwebp, a library for the WebP format
Group: Development/Libraries/C and C++
-Requires: libwebp5 = %version
-Requires: libwebpdemux1 = %version
-Requires: libwebpmux1 = %version
-Requires: libwebpdecoder1 = %version
+Requires: libwebp6 = %version
+Requires: libwebpdemux2 = %version
+Requires: libwebpmux2 = %version
+Requires: libwebpdecoder2 = %version
+Requires: libwebpextras0 = %version
%description devel
WebP is an image format that does lossy compression of digital
@@ -119,42 +132,48 @@
%build
%configure --disable-static \
--enable-libwebpmux --enable-libwebpdemux \
- --enable-libwebpdecoder
-make %{?_smp_mflags}
+ --enable-libwebpdecoder --enable-libwebpextras
+make %{?_smp_mflags} V=1
%install
%make_install
rm -f "%buildroot/%_libdir"/*.la
-%post -n libwebp5 -p /sbin/ldconfig
-%postun -n libwebp5 -p /sbin/ldconfig
-%post -n libwebpdemux1 -p /sbin/ldconfig
-%postun -n libwebpdemux1 -p /sbin/ldconfig
-%post -n libwebpmux1 -p /sbin/ldconfig
-%postun -n libwebpmux1 -p /sbin/ldconfig
-%post -n libwebpdecoder1 -p /sbin/ldconfig
-%postun -n libwebpdecoder1 -p /sbin/ldconfig
+%post -n libwebp6 -p /sbin/ldconfig
+%postun -n libwebp6 -p /sbin/ldconfig
+%post -n libwebpdemux2 -p /sbin/ldconfig
+%postun -n libwebpdemux2 -p /sbin/ldconfig
+%post -n libwebpmux2 -p /sbin/ldconfig
+%postun -n libwebpmux2 -p /sbin/ldconfig
+%post -n libwebpdecoder2 -p /sbin/ldconfig
+%postun -n libwebpdecoder2 -p /sbin/ldconfig
+%post -n libwebpextras0 -p /sbin/ldconfig
+%postun -n libwebpextras0 -p /sbin/ldconfig
%files -n libwebp-tools
%defattr(-,root,root)
%_bindir/*
%_mandir/man*/*
-%files -n libwebp5
+%files -n libwebp6
+%defattr(-,root,root)
+%_libdir/libwebp.so.6*
+
+%files -n libwebpdemux2
%defattr(-,root,root)
-%_libdir/libwebp.so.5*
+%_libdir/libwebpdemux.so.2*
-%files -n libwebpdemux1
+%files -n libwebpmux2
%defattr(-,root,root)
-%_libdir/libwebpdemux.so.1*
+%_libdir/libwebpmux.so.2*
-%files -n libwebpmux1
+%files -n libwebpdecoder2
%defattr(-,root,root)
-%_libdir/libwebpmux.so.1*
+%_libdir/libwebpdecoder.so.2*
-%files -n libwebpdecoder1
+%files -n libwebpextras0
%defattr(-,root,root)
-%_libdir/libwebpdecoder.so.1*
+%_libdir/libwebpextras.so.0*
%files devel
%defattr(-,root,root)
++++++ baselibs.conf ++++++
--- /var/tmp/diff_new_pack.qWD5Or/_old 2016-02-29 09:15:52.000000000 +0100
+++ /var/tmp/diff_new_pack.qWD5Or/_new 2016-02-29 09:15:52.000000000 +0100
@@ -1,10 +1,12 @@
-libwebp5
-libwebpdecoder1
-libwebpdemux1
-libwebpmux1
+libwebp6
+libwebpdecoder2
+libwebpdemux2
+libwebpmux2
+libwebpextras0
libwebp-devel
-requires libwebp-<targettype>
- requires "libwebp5-<targettype> = <version>"
- requires "libwebpdecoder1-<targettype> = <version>"
- requires "libwebpdemux1-<targettype> = <version>"
- requires "libwebpmux1-<targettype> = <version>"
+ requires "libwebp6-<targettype> = <version>"
+ requires "libwebpdecoder2-<targettype> = <version>"
+ requires "libwebpdemux2-<targettype> = <version>"
+ requires "libwebpmux2-<targettype> = <version>"
+ requires "libwebpextras0-<targettype> = <version>"
++++++ libwebp-0.4.4.tar.gz -> libwebp-0.5.0.tar.gz ++++++
++++ 46438 lines of diff (skipped)