leapseconds (empty) → 1.0
raw patch · 5 files changed
+264/−0 lines, 5 filesdep +basedep +leapsecondsdep +tastysetup-changed
Dependencies added: base, leapseconds, tasty, tasty-hunit, time
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- leapseconds.cabal +42/−0
- src/Data/Time/Clock/LeapSeconds.hs +91/−0
- test/Test.hs +99/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ashley Yakeley (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Ashley Yakeley nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ leapseconds.cabal view
@@ -0,0 +1,42 @@+cabal-version: >=1.10+name: leapseconds+version: 1.0+category: Time+description: Interpretation of leap second files.+author: Ashley Yakeley+license: BSD3+license-file: LICENSE+maintainer: ashley@semantic.org+copyright: 2016 Ashley Yakeley+build-type: Simple++source-repository head+ type: git+ location: https://github.com/AshleyYakeley/leapseconds++library+ hs-source-dirs: src+ exposed-modules:+ Data.Time.Clock.LeapSeconds+ build-depends:+ base >= 4.7 && < 5,+ time >= 1.7+ default-language: Haskell2010+ default-extensions:+ ghc-options: -Wall++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ build-depends:+ base,+ time,+ tasty,+ tasty-hunit,+ leapseconds+ default-language: Haskell2010+ default-extensions:+ StandaloneDeriving+ ghc-options: -Wall+ main-is: Test.hs+ other-modules:
+ src/Data/Time/Clock/LeapSeconds.hs view
@@ -0,0 +1,91 @@+-- | Interpretation of leap second files.+module Data.Time.Clock.LeapSeconds+(+ LeapSecondMap,+ LeapSecondList(..),+ parseNISTLeapSecondList,+ leapSecondListToMap,+) where+{+ import Data.Maybe;+ import Text.Read;+ import Data.Time;+ import Data.Time.Clock.TAI;+++ -- | A list of leap-second transitions, etc.+ ;+ data LeapSecondList = MkLeapSecondList+ {+ lslVersion :: Day, -- when the list was created+ lslExpiration :: Day, -- when the list expires+ lslTransitions :: [(Day,Int)] -- transitions: TAI - UTC starting at this day+ } deriving Eq;++ -- | 1900-01-01+ ;+ ntpEpochDay :: Day;+ ntpEpochDay = ModifiedJulianDay 15020;++ ntpDateStringToDay :: String -> Maybe Day;+ ntpDateStringToDay s = do+ {+ n <- readMaybe s;+ return $ addDays (div n 86400) ntpEpochDay;+ };++ single :: [a] -> Maybe a;+ single [a] = return a;+ single _ = Nothing;++ separate :: Char -> String -> [String];+ separate sep s = let+ {+ (val,rest) = break ((==) sep) s;+ vals = case rest of+ {+ [] -> [];+ _:s' -> separate sep s';+ };+ } in val : vals;++ -- | Parse the text of a NIST leap-second file. This file can be found at <ftp://time.nist.gov/pub/leap-seconds.list>,+ -- and on UNIX systems, at @\/usr\/share\/zoneinfo\/leap-seconds.list@.+ ;+ parseNISTLeapSecondList :: String -> Maybe LeapSecondList;+ parseNISTLeapSecondList text = do+ {+ let+ {+ readLine ('#':'$':s) | Just version <- ntpDateStringToDay s = return (Just version,Nothing,Nothing);+ readLine ('#':'@':s) | Just expiration <- ntpDateStringToDay s = return (Nothing,Just expiration,Nothing);+ readLine ('#':_) = return (Nothing,Nothing,Nothing);+ readLine "" = return (Nothing,Nothing,Nothing);+ readLine s = case separate '\t' s of+ {+ (tstr:ostr:_) | Just t <- ntpDateStringToDay tstr, Just offset <- readMaybe ostr -> return $ (Nothing,Nothing,Just (t,offset));+ _ -> Nothing;+ };+ };+ mstrs <- traverse readLine $ lines text;+ version <- single $ catMaybes $ fmap (\(x,_,_) -> x) mstrs;+ expiration <- single $ catMaybes $ fmap (\(_,x,_) -> x) mstrs;+ let+ {+ transitions = catMaybes $ fmap (\(_,_,x) -> x) mstrs;+ };+ return $ MkLeapSecondList version expiration transitions;+ };++ -- | Obtain a map that can be used to convert between TAI and UTC (see "Data.Time.Clock.TAI")+ ;+ leapSecondListToMap :: LeapSecondList -> LeapSecondMap;+ leapSecondListToMap lsl day | day >= lslExpiration lsl = Nothing;+ leapSecondListToMap lsl day = let+ {+ findInList :: [(Day,Int)] -> Maybe Int -> Maybe Int;+ findInList [] mi = mi;+ findInList ((d,_):_) mi | day < d = mi;+ findInList ((_,i):rest) _ = findInList rest (Just i);+ } in findInList (lslTransitions lsl) Nothing;+}
+ test/Test.hs view
@@ -0,0 +1,99 @@+{-# OPTIONS -fno-warn-orphans #-}+module Main(main) where+{+ import Test.Tasty;+ import Test.Tasty.HUnit;+ import Data.Time;+ import Data.Time.Clock.TAI;+ import Data.Time.Clock.LeapSeconds;+++ testParseNISTLeapSecondList :: TestTree;+ testParseNISTLeapSecondList = testCase "parseNISTLeapSecondList" $ let+ {+ jan y = fromGregorian y 1 1;+ jul y = fromGregorian y 7 1;++ refList :: LeapSecondList;+ refList = MkLeapSecondList+ {+ lslVersion = fromGregorian 2016 7 8,+ lslExpiration = fromGregorian 2017 6 28,+ lslTransitions =+ zip+ [+ jan 1972,+ jul 1972,+ jan 1973,+ jan 1974,+ jan 1975,+ jan 1976,+ jan 1977,+ jan 1978,+ jan 1979,+ jan 1980,+ jul 1981,+ jul 1982,+ jul 1983,+ jul 1985,+ jan 1988,+ jan 1990,+ jan 1991,+ jul 1992,+ jul 1993,+ jul 1994,+ jan 1996,+ jul 1997,+ jan 1999,+ jan 2006,+ jan 2009,+ jul 2012,+ jul 2015,+ jan 2017+ ]+ [10..]+ };+ } in do+ {+ fileString <- readFile "test/leap-seconds.list";+ assertEqual "LeapSecondList" (Just refList) $ parseNISTLeapSecondList fileString;+ };++ deriving instance Show LeapSecondList;++ testLeapSecondListToMap :: TestTree;+ testLeapSecondListToMap = testCase "leapSecondListToMap" $ let+ {+ sampleLeapSecondList :: LeapSecondList;+ sampleLeapSecondList = MkLeapSecondList+ {+ lslVersion = fromGregorian 1974 1 1,+ lslExpiration = fromGregorian 1975 1 1,+ lslTransitions =+ [+ (fromGregorian 1972 1 1,10),+ (fromGregorian 1972 7 1,11)+ ]+ };++ sampleLeapSecondMap :: LeapSecondMap;+ sampleLeapSecondMap = leapSecondListToMap sampleLeapSecondList;++ assertVal expected day = assertEqual (show day) expected $ sampleLeapSecondMap day;+ } in do+ {+ assertVal Nothing (fromGregorian 1971 12 31);+ assertVal (Just 10) (fromGregorian 1972 1 1);+ assertVal (Just 10) (fromGregorian 1972 6 31);+ assertVal (Just 11) (fromGregorian 1972 7 1);+ assertVal (Just 11) (fromGregorian 1974 12 31);+ assertVal Nothing (fromGregorian 1975 1 1);+ };++ main :: IO ();+ main = defaultMain $ testGroup "leapseconds" $+ [+ testParseNISTLeapSecondList,+ testLeapSecondListToMap+ ];+}