om-time (empty) → 0.3.0.2

raw patch · 5 files changed

+169/−0 lines, 5 filesdep +aesondep +basedep +binarysetup-changed

Dependencies added: aeson, base, binary, clock, time, transformers

Files

• LICENSE +19/−0
• README.md +7/−0
• Setup.hs +2/−0
• om-time.cabal +45/−0
• src/OM/Time.hs +96/−0

@@ -0,0 +1,19 @@+Copyright 2022 Rick Owens++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the "Software"),+to deal in the Software without restriction, including without limitation+the rights to use, copy, modify, merge, publish, distribute, sublicense,+and/or sell copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,7 @@+# om-time++Some simple time utilities used by other `om-*` packages.++Mostly this contains a newtype wrapper around `UTCTime` that has a+`Binary` instance, and a monad interface to provide the current time.+

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,45 @@+cabal-version:       3.0+name:                om-time+version:             0.3.0.2+synopsis:            Misc. time utilites+description:         A monad interface for obtain the current TimeSpec, along+                     with a few other utilities.+license:             MIT+license-file:        LICENSE+author:              Rick Owens+maintainer:          rick@owensmurray.com+copyright:           2022 Rick Owens+-- category:+build-type:          Simple+extra-source-files:+  LICENSE+  README.md++common dependencies+  build-depends:+    , aeson        >= 2.0.3.0  && < 2.1+    , base         >= 4.15.1.0 && < 4.16+    , binary       >= 0.8.8.0  && < 0.9+    , clock        >= 0.8.3    && < 0.9+    , time         >= 1.9.3    && < 1.10+    , transformers >= 0.5.6.2  && < 0.6++common warnings+  ghc-options:+    -Wmissing-deriving-strategies+    -Wmissing-export-lists+    -Wmissing-import-lists+    -Wredundant-constraints+    -Wall+++library+  import: dependencies, warnings+  exposed-modules:+    OM.Time+  -- other-modules:+  -- other-extensions:+  hs-source-dirs: src+  default-language: Haskell2010++

@@ -0,0 +1,96 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}++{- | Basic missing time utilities. -}+module OM.Time (+  MonadTimeSpec(..),+  Time(..),+  timed,+  diffTimeSpec,+  addTime,+) where+++import Control.Monad.Trans.Class (MonadTrans(lift))+import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)+import Data.Binary (Binary, get, put)+import Data.Int (Int64)+import Data.Time (Day(ModifiedJulianDay), UTCTime(UTCTime), DiffTime)+import System.Clock (TimeSpec)+import qualified System.Clock as Clock+++{- | Wrapper around 'UTCTime', used mainly to provide a 'Binary' instance. -}+newtype Time = Time {+    unTime :: UTCTime+  }+  deriving newtype (Eq, Ord, ToJSON, FromJSON, ToJSONKey, FromJSONKey)+instance Show Time where+  showsPrec n = showsPrec n . unTime+instance Binary Time where+  put (Time (UTCTime (ModifiedJulianDay day) tod)) = +    put (day, toRational tod)+  get = do+    (day, tod) <- get+    return (Time (UTCTime (ModifiedJulianDay day) (fromRational tod)))+++{- | A monad that can produce the current time as a TimeSpec. -}+class (Monad m) => MonadTimeSpec m where+  getTime :: m TimeSpec++{- | The IO instances uses 'Clock.getTime' 'Clock.MonotonicCoarse'. -}+instance MonadTimeSpec IO where+  getTime = Clock.getTime Clock.MonotonicCoarse++instance {-# OVERLAPPABLE #-}+    ( Monad (t m)+    , MonadTimeSpec m+    , MonadTrans t+    )+  =>+    MonadTimeSpec (t m)+  where+    getTime = lift getTime+++{- | Perform an action and measure how long it takes. -}+timed+  :: MonadTimeSpec m+  => m a+  -> m (a, DiffTime)+timed action = do+  start <- getTime+  result <- action+  end <- getTime+  pure (result, diffTimeSpec end start)+++{- | Take the difference of two time specs, as a 'DiffTime'. -}+diffTimeSpec :: TimeSpec -> TimeSpec -> DiffTime+diffTimeSpec a b =+  realToFrac (Clock.toNanoSecs (Clock.diffTimeSpec a b)) / 1_000_000_000+++{- | Add a 'DiffTime' to a 'TimeSpec'. -}+addTime :: DiffTime -> TimeSpec -> TimeSpec+addTime diff time =+  let+    rat = toRational diff++    secDiff :: Int64+    secDiff = truncate rat++    nsecDiff :: Int64+    nsecDiff = truncate ((toRational diff - toRational secDiff) * 1_000_000_000)+  in+    Clock.TimeSpec {+      Clock.sec = Clock.sec time + secDiff,+      Clock.nsec = Clock.nsec time + nsecDiff+    }++