Initial commit. Note that Data/Time/Clock/AnnouncedLeapSeconds.hs is …

…autogenerated and should perhaps not be in repo...

.gitignore

@@ -0,0 +1,6 @@
+*.[oa]
+*.exe
+*.exe.manifest
+*.hi
+*~
+*.swp

Data/Time/Clock/AnnouncedLeapSeconds.hs

@@ -0,0 +1,66 @@
+{- |
+   Copyright  : Copyright (C) 2009 Bjorn Buckwalter
+   License    : BSD3
+
+   Maintainer : bjorn.buckwalter@gmail.com
+   Stability  : stable
+   Portability: full
+
+Provides a static 'Data.Time.Clock.TAI.LeapSecondTable' \"containing\"
+the leap seconds announced at library release time. This version
+will become invalidated when/if the International Earth Rotation
+and Reference Systems Service (IERS) announces a new leap second at
+<http://hpiers.obspm.fr/eoppc/bul/bulc/bulletinc.dat>.
+At that time a new version of the library will be released and
+any code wishing to remain up to date should recompile against
+that version.
+
+This module is intended to provide a quick-and-dirty leap second solution
+for one-off analyses concerned only with the past and present (i.e. up
+until the next as of yet unannounced leap second), or for applications
+which can afford to be recompiled against an updated library as often
+as every six months.
+-}
+
+module Data.Time.Clock.AnnouncedLeapSeconds (lst) where
+
+import Data.Time (Day, fromGregorian)
+import Data.Time.Clock.TAI (LeapSecondTable)
+
+leapSeconds :: [(Day, Integer)]
+leapSeconds = (fromGregorian 2009 01 01, 34)
+  : (fromGregorian 2006 01 01, 33)
+  : (fromGregorian 1999 01 01, 32)
+  : (fromGregorian 1997 07 01, 31)
+  : (fromGregorian 1996 01 01, 30)
+  : (fromGregorian 1994 07 01, 29)
+  : (fromGregorian 1993 07 01, 28)
+  : (fromGregorian 1992 07 01, 27)
+  : (fromGregorian 1991 01 01, 26)
+  : (fromGregorian 1990 01 01, 25)
+  : (fromGregorian 1988 01 01, 24)
+  : (fromGregorian 1985 07 01, 23)
+  : (fromGregorian 1983 07 01, 22)
+  : (fromGregorian 1982 07 01, 21)
+  : (fromGregorian 1981 07 01, 20)
+  : (fromGregorian 1980 01 01, 19)
+  : (fromGregorian 1979 01 01, 18)
+  : (fromGregorian 1978 01 01, 17)
+  : (fromGregorian 1977 01 01, 16)
+  : (fromGregorian 1976 01 01, 15)
+  : (fromGregorian 1975 01 01, 14)
+  : (fromGregorian 1974 01 01, 13)
+  : (fromGregorian 1973 01 01, 12)
+  : (fromGregorian 1972 07 01, 11)
+  : (fromGregorian 1972 01 01, 10)
+  : (fromGregorian 1966 01 01, 4)
+  : (fromGregorian 1964 01 01, 3)
+  : (fromGregorian 1962 01 01, 1)
+  : []
+
+-- | 'Data.Time.Clock.TAI.LeapSecondTable' containing all leap seconds
+-- up to 2009-01-01.
+lst :: LeapSecondTable
+lst d = snd $ headDef (undefined,0) $ dropWhile ((>d).fst) leapSeconds
+  where headDef def xs = if null xs then def else head xs  -- Inspired by Safe.
+

LICENSE

@@ -0,0 +1,31 @@
+Copyright (c) 2009, Bjorn Buckwalter.
+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 the copyright holder(s) nor the names of
+    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.

MakeLeapSecondTable.hs

@@ -0,0 +1,92 @@
+{-
+Use this applicaton to generate the 'Data.Time.Clock.AnnouncedLeapSeconds'
+module. Compile and pipe a EOP file from Celestrak through the binary,
+e.g.:
+
+  curl http://www.celestrak.com/SpaceData/eop19620101.txt | ./MakeLeapSecondTable > Data/Time/Clock/AnnouncedLeapSeconds.hs
+
+-}
+
+import Astro.Celestrak
+
+import Data.List
+import Data.Time
+import Data.Time.Clock.TAI
+import Data.Time.Format
+import Safe
+import System.Locale (defaultTimeLocale)
+
+
+-- | Converts an 'EOPList' into a minimal list of (day, leapsecond) pairs
+-- in reverse chronological order.
+eopToLS :: EOPList a -> [(Day, Integer)]
+eopToLS = reverse . filterLS . fmap (fmap deltaAT)
+
+filterLS :: Eq a => [(b,a)] -> [(b,a)]
+filterLS (x:xs) = x : filterLS (dropWhile ((== snd x) . snd) xs)
+filterLS [] = []
+
+-- | Converts an 'EOPList' to a light weight 'LeapSecondTable' (its internal
+-- data is a short list as opposed to a huge array for the 'LeapSecondTable'
+-- provided by "Astro.Celestrak".
+eopToLST :: EOPList a -> LeapSecondTable
+eopToLST eops d = snd $ headDef (undefined,0) $ dropWhile ((>d).fst) $ eopToLS eops
+
+-- | Convert a day/leapsecond pair into a compilable string.
+lsToString :: (Day, Integer) -> String
+lsToString (d,s) = formatTime defaultTimeLocale fmt d
+  where fmt = "(fromGregorian %Y %m %d, " ++ show s ++ ")"
+
+-- | Shows a list in compilable format using the passed function to display
+-- the elements of the list.
+showL :: (a -> String) -> [a] -> String
+showL showf xs = intercalate "\n  : " (map showf xs) ++ "\n  : []"
+
+-- | Prints a leapsecond module.
+showModule :: EOPList a -> String
+showModule eops = unlines
+  [ "{- |"
+  , "   Copyright  : Copyright (C) 2009 Bjorn Buckwalter"
+  , "   License    : BSD3"
+  , ""
+  , "   Maintainer : bjorn.buckwalter@gmail.com"
+  , "   Stability  : stable"
+  , "   Portability: full"
+  , ""
+  , "Provides a static 'Data.Time.Clock.TAI.LeapSecondTable' \\\"containing\\\""
+  , "the leap seconds announced at library release time. This version"
+  , "will become invalidated when/if the International Earth Rotation"
+  , "and Reference Systems Service (IERS) announces a new leap second at"
+  , "<http://hpiers.obspm.fr/eoppc/bul/bulc/bulletinc.dat>."
+  , "At that time a new version of the library will be released and"
+  , "any code wishing to remain up to date should recompile against"
+  , "that version."
+  , ""
+  , "This module is intended to provide a quick-and-dirty leap second solution"
+  , "for one-off analyses concerned only with the past and present (i.e. up"
+  , "until the next as of yet unannounced leap second), or for applications"
+  , "which can afford to be recompiled against an updated library as often"
+  , "as every six months."
+  , "-}"
+  , ""
+  , "module Data.Time.Clock.AnnouncedLeapSeconds (lst) where"
+  , ""
+  , "import Data.Time (Day, fromGregorian)"
+  , "import Data.Time.Clock.TAI (LeapSecondTable)"
+  , ""
+  , "leapSeconds :: [(Day, Integer)]"
+  , "leapSeconds = " ++ showL lsToString ls
+  , ""
+  , "-- | 'Data.Time.Clock.TAI.LeapSecondTable' containing all leap seconds"
+  , "-- up to " ++ (show.fst.head) ls ++ "."
+  , "lst :: LeapSecondTable"
+  , "lst d = snd $ headDef (undefined,0) $ dropWhile ((>d).fst) leapSeconds"
+  , "  where headDef def xs = if null xs then def else head xs  -- Inspired by Safe."
+  , ""
+  ] where ls = eopToLS eops
+
+main = do
+  interact (showModule . parseEOPData)
+
+
+

Setup.lhs

@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain

TestLeapSeconds.hs

@@ -0,0 +1,13 @@
+import Data.Time
+import Data.Time.Clock.AnnouncedLeapSeconds
+import Test.QuickCheck
+
+onceCheck = check (defaultConfig {configMaxTest = 1})
+
+-- A few trivial tests.
+main = do
+  onceCheck $ lst (fromGregorian 1111 12 31) ==  0  -- Before first leap second.
+  onceCheck $ lst (fromGregorian 2008 12 31) == 33  -- Prior to last leap second.
+  onceCheck $ lst (fromGregorian 2009 01 01) == 34  -- Last leap second.
+  onceCheck $ lst (fromGregorian 2009 12 31) == 34  -- Beyond last leap second.
+

leapseconds-announced.cabal

@@ -0,0 +1,18 @@
+Name:                leapseconds-announced
+Version:             2009
+License:             BSD3
+License-File:        LICENSE
+Copyright:           Bjorn Buckwalter 2009
+Author:              Bjorn Buckwalter 
+Maintainer:          bjorn.buckwalter@gmail.com
+Stability:           Stable
+Synopsis:            Leap seconds announced at library release time.
+Description:
+    Provides an easy to use static 'Data.Time.Clock.TAI.LeapSecondTable'
+    with the leap seconds announced at library release time.
+Category:            System
+Build-Type:          Simple
+Build-Depends:       base, time
+Exposed-Modules:     Data.Time.Clock.AnnouncedLeapSeconds
+Extra-source-files:  TestLeapSeconds.lhs
+