diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -0,0 +1,32 @@ +Time to manipulate time + +Copyright © 2013-2017 Operational Dynamics Consulting, Pty Ltd and Others +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + + 3. Neither the name of the project nor the names of its 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. diff --git a/chronologique.cabal b/chronologique.cabal new file mode 100644 --- /dev/null +++ b/chronologique.cabal @@ -0,0 +1,88 @@ +cabal-version: >= 1.10 +name: chronologique +version: 0.2.1.0 +synopsis: Time to manipulate time +description: + A simple type useful for representing timestamps as generated by system + events, along with conveniences for converting between time types from common + Haskell time libraries. + . + Our original use was wanting to conveniently measure things happening on + distributed computer systems. Since machine clock cycles are in units of + nanoseconds, this has the nice property that, assuming the system clock is not + corrupted, two subsequent events from the same source process are likely to + have monotonically increasing timestamps. And even if the system clock has + skew, they're still decently likely to be unique per device. These TimeStamps + thus make good keys when building Maps. + . + The core type is in "Chrono.TimeStamp", see there for full documentation. + +license: BSD3 +license-file: LICENCE +author: Andrew Cowie +maintainer: Andrew Cowie +copyright: © 2016-2017 Operational Dynamics Consulting Pty Ltd, and Others +category: Text +tested-with: GHC == 8.0 + +build-type: Simple + +library + default-language: Haskell2010 + + build-depends: base >= 4.9 && < 5, + time, + hourglass + + hs-source-dirs: lib + + exposed-modules: Chrono.TimeStamp + Chrono.Compat + other-modules: Chrono.Formats + + ghc-options: -Wall + -Wwarn + -fwarn-tabs + +test-suite experiment + type: exitcode-stdio-1.0 + default-language: Haskell2010 + buildable: False + + build-depends: base, + chronologique + + hs-source-dirs: tests + + main-is: Experiment.hs + + ghc-options: -threaded + -O2 + -Wall + -Wwarn + -fwarn-tabs + + +test-suite check + type: exitcode-stdio-1.0 + default-language: Haskell2010 + + build-depends: base, + hspec, + hourglass, + QuickCheck, + chronologique + + hs-source-dirs: tests + + main-is: TestSuite.hs + + other-modules: CheckTimeStamp + + ghc-options: -threaded + -O2 + -Wall + -Wwarn + -fwarn-tabs + +-- vim: set tabstop=22 expandtab: diff --git a/lib/Chrono/Compat.hs b/lib/Chrono/Compat.hs new file mode 100644 --- /dev/null +++ b/lib/Chrono/Compat.hs @@ -0,0 +1,73 @@ +-- +-- Time to manipulate time +-- +-- Copyright © 2013-2016 Operational Dynamics Consulting, Pty Ltd and Others +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the 3-clause BSD licence. +-- + +-- +-- | Compatibility with time types from other time handling libraries. Some of +-- these are just conveniences, but it's not always obvious how to convert +-- between time types even in the same package. +-- +module Chrono.Compat +( + -- * time package, from base + convertToPosix + , convertFromPosix + , convertToUTC + , convertFromUTC + -- * hourglass package + , convertToHourglass + , convertFromHourglass +) where + +import Data.Int (Int64) +import Data.Hourglass +import Data.Time.Clock +import Data.Time.Clock.POSIX + +import Chrono.TimeStamp + +-- +-- | Utility function to convert nanoseconds since Unix epoch to a +-- 'NominalDiffTime', allowing you to then use the time manipulation +-- functions in "Data.Time.Clock" from __time__. +-- +convertToPosix :: TimeStamp -> POSIXTime +convertToPosix = fromRational . (/ 1e9) . fromIntegral + +-- +-- +-- | Utility function to convert nanoseconds since Unix epoch to a +-- 'ElapsedP', allowing you to then use the time manipulation +-- functions in the __hourglass__ package. +-- +convertToHourglass :: TimeStamp -> ElapsedP +convertToHourglass = timeGetElapsedP + +convertFromHourglass :: ElapsedP -> TimeStamp +convertFromHourglass = timeFromElapsedP + + +-- +-- | Annoyingly, the various types in __time__ don't interoperate. Quite frequently +-- you need to get to, or from, 'UTCTime'. +-- +convertToUTC :: TimeStamp -> UTCTime +convertToUTC = posixSecondsToUTCTime . convertToPosix + +convertFromUTC :: UTCTime -> TimeStamp +convertFromUTC = convertFromPosix . utcTimeToPOSIXSeconds + +convertFromPosix :: POSIXTime -> TimeStamp +convertFromPosix = + let + nano :: POSIXTime -> Int64 + nano = floor . (* 1000000000) . toRational + in + TimeStamp . fromIntegral . nano diff --git a/lib/Chrono/Formats.hs b/lib/Chrono/Formats.hs new file mode 100644 --- /dev/null +++ b/lib/Chrono/Formats.hs @@ -0,0 +1,116 @@ +-- +-- Time to manipulate time +-- +-- Copyright © 2013-2016 Operational Dynamics Consulting, Pty Ltd and Others +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the 3-clause BSD licence. +-- + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Chrono.Formats +( + ISO8601_Precise(..) + , ISO8601_Seconds(..) + , ISO8601_Days(..) + , Posix_Precise(..) + , Posix_Micro(..) + , Posix_Milli(..) + , Posix_Seconds(..) +) where + +import Data.Hourglass + +-- +-- | Format string describing full (nanosecond) precision ISO8601 time, +-- +-- > 2014-07-31T23:09:35.274387019Z +-- +data ISO8601_Precise = ISO8601_Precise + +instance TimeFormat ISO8601_Precise where + toFormat _ = TimeFormatString + [ Format_Year + , Format_Text '-' + , Format_Month2 + , Format_Text '-' + , Format_Day2 + , Format_Text 'T' + , Format_Hour + , Format_Text ':' + , Format_Minute + , Format_Text ':' + , Format_Second + , Format_Text '.' + , Format_Precision 9 + , Format_Text 'Z' + ] + +data ISO8601_Seconds = ISO8601_Seconds + +instance TimeFormat ISO8601_Seconds where + toFormat _ = TimeFormatString + [ Format_Year + , Format_Text '-' + , Format_Month2 + , Format_Text '-' + , Format_Day2 + , Format_Text 'T' + , Format_Hour + , Format_Text ':' + , Format_Minute + , Format_Text ':' + , Format_Second + , Format_Text 'Z' + ] + +data ISO8601_Days = ISO8601_Days + +instance TimeFormat ISO8601_Days where + toFormat _ = TimeFormatString + [ Format_Year + , Format_Text '-' + , Format_Month2 + , Format_Text '-' + , Format_Day2 + ] + +data Posix_Precise = Posix_Precise + +instance TimeFormat Posix_Precise where + toFormat _ = TimeFormatString + [ Format_UnixSecond + , Format_Text '.' + , Format_MilliSecond + , Format_MicroSecond + , Format_NanoSecond + ] + +data Posix_Micro = Posix_Micro + +instance TimeFormat Posix_Micro where + toFormat _ = TimeFormatString + [ Format_UnixSecond + , Format_Text '.' + , Format_MilliSecond + , Format_MicroSecond + ] + +data Posix_Milli = Posix_Milli + +instance TimeFormat Posix_Milli where + toFormat _ = TimeFormatString + [ Format_UnixSecond + , Format_Text '.' + , Format_MilliSecond + ] + +data Posix_Seconds = Posix_Seconds + +instance TimeFormat Posix_Seconds where + toFormat _ = TimeFormatString + [ Format_UnixSecond + ] diff --git a/lib/Chrono/TimeStamp.hs b/lib/Chrono/TimeStamp.hs new file mode 100644 --- /dev/null +++ b/lib/Chrono/TimeStamp.hs @@ -0,0 +1,131 @@ +-- +-- Time to manipulate time +-- +-- Copyright © 2013-2016 Operational Dynamics Consulting, Pty Ltd and Others +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the 3-clause BSD licence. +-- + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TupleSections #-} + +module Chrono.TimeStamp +( + TimeStamp(..) + , getCurrentTimeNanoseconds + + , ISO8601_Precise(..) +) where + +import Control.Applicative +import Data.Maybe +import Data.Int (Int64) +import Data.Hourglass +import Time.System + +import Chrono.Formats + +-- +-- | Number of nanoseconds since the Unix epoch. +-- +-- The Show instance displays the TimeStamp as seconds with the nanosecond +-- precision expressed as a decimal amount after the interger, ie: +-- +-- >>> t <- getCurrentTimeNanoseconds +-- >>> show t +-- 2014-07-31T23:09:35.274387031Z +-- +-- However this doesn't change the fact the underlying representation counts +-- nanoseconds since epoch: +-- +-- >>> show $ unTimeStamp t +-- 1406848175274387031 +-- +-- There is a Read instance that is reasonably accommodating. +-- +-- >>> read "2014-07-31T13:05:04.942089001Z" :: TimeStamp +-- 2014-07-31T13:05:04.942089001Z +-- +-- >>> read "1406811904.942089001" :: TimeStamp +-- 2014-07-31T13:05:04.942089001Z +-- +-- >>> read "1406811904" :: TimeStamp +-- 2014-07-31T13:05:04.000000000Z +-- +-- In case you're wondering, the valid range of nanoseconds that fits into the +-- underlying Int64 is: +-- +-- >>> show $ minBound :: TimeStamp +-- 1677-09-21T00:12:43.145224192Z +-- +-- >>> show $ maxBound :: TimeStamp +-- 2262-04-11T23:47:16.854775807Z +-- +-- so in a quarter millenium's time, yes, you'll have the Y2262 Problem. +-- Haskell code from today will, of course, still be running, so in the mid +-- Twenty-Third century you will need to replace this implementation with +-- something else. +-- +newtype TimeStamp = TimeStamp { + unTimeStamp :: Int64 +} deriving (Eq, Ord, Enum, Num, Real, Integral, Bounded) + +{- + Hourglass works by sending types in and out of the Timeable and Time + typeclasses. They're not particularly easy to work with, but they're a + prerequisite for using timePrint +-} + +instance Timeable TimeStamp where + timeGetElapsedP :: TimeStamp -> ElapsedP + timeGetElapsedP (TimeStamp ticks) = + let + (s,ns) = divMod ticks 1000000000 + in + ElapsedP (Elapsed (Seconds (s))) (NanoSeconds (ns)) + +instance Time TimeStamp where + timeFromElapsedP :: ElapsedP -> TimeStamp + timeFromElapsedP (ElapsedP (Elapsed (Seconds seconds)) (NanoSeconds nanoseconds)) = + let + s = fromIntegral seconds :: Int64 + ns = fromIntegral nanoseconds + in + TimeStamp $! (s * 1000000000) + ns + + +instance Show TimeStamp where + show t = + timePrint ISO8601_Precise t + +instance Read TimeStamp where + readsPrec _ s = maybeToList $ (,"") <$> reduceDateTime <$> parse s + where + parse :: String -> Maybe DateTime + parse x = timeParse ISO8601_Precise x + <|> timeParse ISO8601_Seconds x + <|> timeParse ISO8601_DateAndTime x -- from hourglass + <|> timeParse ISO8601_Date x -- from hourglass + <|> timeParse Posix_Precise x + <|> timeParse Posix_Micro x + <|> timeParse Posix_Milli x + <|> timeParse Posix_Seconds x + +reduceDateTime :: DateTime -> TimeStamp +reduceDateTime = timeFromElapsedP . timeGetElapsedP + +-- +-- | Get the current system time, expressed as a 'TimeStamp' (which is to +-- say, number of nanoseconds since the Unix epoch). +-- +getCurrentTimeNanoseconds :: IO TimeStamp +getCurrentTimeNanoseconds = do + p <- timeCurrentP + return $! convertToTimeStamp p + +convertToTimeStamp :: ElapsedP -> TimeStamp +convertToTimeStamp = timeFromElapsedP diff --git a/tests/CheckTimeStamp.hs b/tests/CheckTimeStamp.hs new file mode 100644 --- /dev/null +++ b/tests/CheckTimeStamp.hs @@ -0,0 +1,114 @@ +-- +-- Time to manipulate time +-- +-- Copyright © 2013-2016 Operational Dynamics Consulting, Pty Ltd and Others +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the 3-clause BSD licence. +-- + +-- | Test serialisation/deserialiastion for TimeStamp type + +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE NegativeLiterals #-} +{-# OPTIONS -fno-warn-orphans #-} + +module CheckTimeStamp where + +import Test.Hspec +import Test.QuickCheck +import Data.Hourglass + +import Chrono.TimeStamp +import Chrono.Compat + +checkTimeStamp :: Spec +checkTimeStamp = do + describe "Smallest valid TimeStamp" $ + let + t = TimeStamp (-9223372036854775808) + in do + it "should be representable" $ do + t `shouldBe` (minBound :: TimeStamp) + + it "should be match when Shown" $ do + show t `shouldBe` show (minBound :: TimeStamp) + + it "should equal expected value" $ do + show t `shouldBe` "1677-09-21T00:12:43.145224192Z" + + describe "Largest valid TimeStamp" $ + let + t = TimeStamp 9223372036854775807 + in do + it "should be representable" $ do + t `shouldBe` (maxBound :: TimeStamp) + + it "should be match when Shown" $ do + show t `shouldBe` show (maxBound :: TimeStamp) + + it "should equal expected value" $ do + show t `shouldBe` "2262-04-11T23:47:16.854775807Z" + + describe "Printing and parsing with precise format" $ do + it "formats a known date correctly" $ do + timePrint ISO8601_Precise (TimeStamp 1406849015948797001) `shouldBe` "2014-07-31T23:23:35.948797001Z" + + it "uses timeParse effectively" $ do + timeParse ISO8601_Precise "2014-07-31T23:42:35.948797001Z" `shouldBe` + Just (DateTime (Date 2014 July 31) (TimeOfDay 23 42 35 948797001)) + + describe "Round trip through Read and Show instances" $ do + it "outputs a correctly formated ISO 8601 timestamp when Shown" $ do + show (TimeStamp 1406849015948797001) `shouldBe` "2014-07-31T23:23:35.948797001Z" + show (TimeStamp 1406849015948797001) `shouldBe` "2014-07-31T23:23:35.948797001Z" + show (TimeStamp 0) `shouldBe` "1970-01-01T00:00:00.000000000Z" + + it "Reads ISO 8601 timestamps" $ do + read "2014-07-31T23:23:35.948797001Z" `shouldBe` TimeStamp 1406849015948797001 + read "2014-07-31T23:23:35Z" `shouldBe` TimeStamp 1406849015000000000 + read "2014-07-31" `shouldBe` TimeStamp 1406764800000000000 + + it "reads the Unix epoch date" $ + read "1970-01-01" `shouldBe` TimeStamp 0 + + it "permissively reads various formats" $ do + show (read "1970-01-01T00:00:00.000000000Z" :: TimeStamp) `shouldBe` "1970-01-01T00:00:00.000000000Z" + show (read "1970-01-01" :: TimeStamp) `shouldBe` "1970-01-01T00:00:00.000000000Z" + show (read "0" :: TimeStamp) `shouldBe` "1970-01-01T00:00:00.000000000Z" + + it "permissively reads Posix seconds since epoch" $ do + show (read "1406849015.948797001" :: TimeStamp) `shouldBe` "2014-07-31T23:23:35.948797001Z" + show (read "1406849015.948797" :: TimeStamp) `shouldBe` "2014-07-31T23:23:35.948797000Z" + show (read "1406849015.948" :: TimeStamp) `shouldBe` "2014-07-31T23:23:35.948000000Z" + show (read "1406849015" :: TimeStamp) `shouldBe` "2014-07-31T23:23:35.000000000Z" +{- + This is a bit fragile, depending as it does on the serialization to String + in the Show instance of UTCTime. Not that they're going to change it + anytime soon. +-} + + describe "Round trip through base time types" $ do + it "converts to POSIXTime and back again" $ do + let t = TimeStamp 1406849015948797001 + convertFromPosix (convertToPosix t) `shouldBe` t + show (convertToPosix t) `shouldBe` "1406849015.948797001s" + + it "converts to UTCTime and back again" $ do + let t = TimeStamp 1406849015948797001 + convertFromUTC (convertToUTC t) `shouldBe` t + show (convertToUTC t) `shouldBe` "2014-07-31 23:23:35.948797001 UTC" + + it "behaves when QuickChecked" $ do + property prop_RoundTrip + + +instance Arbitrary TimeStamp where + arbitrary = do + tick <- arbitrary + return (TimeStamp tick) + +prop_RoundTrip :: TimeStamp -> Bool +prop_RoundTrip t = (read . show) t == t diff --git a/tests/Experiment.hs b/tests/Experiment.hs new file mode 100644 --- /dev/null +++ b/tests/Experiment.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS -fno-warn-unused-imports #-} + +module Main where + +import Chrono.TimeStamp + +main :: IO () +main = do + putStrLn "Hello" + diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs new file mode 100644 --- /dev/null +++ b/tests/TestSuite.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Test.Hspec + +import CheckTimeStamp + +main :: IO () +main = hspec suite + +suite :: Spec +suite = do + checkTimeStamp +