polysemy-time 0.1.0.0 → 0.1.1.0

raw patch · 13 files changed

+110/−22 lines, 13 filesdep ~polysemyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: polysemy

API changes (from Hackage documentation)

Files

• changelog.md +4/−0
• lib/Polysemy/Time.hs +1/−1
• lib/Polysemy/Time/At.hs +5/−0
• lib/Polysemy/Time/Class/Instant.hs +14/−0
• lib/Polysemy/Time/Data/Time.hs +3/−1
• lib/Polysemy/Time/Data/TimeUnit.hs +37/−13
• lib/Polysemy/Time/Diff.hs +17/−0
• lib/Polysemy/Time/Ghc.hs +2/−0
• lib/Polysemy/Time/Orphans.hs +2/−2
• polysemy-time.cabal +6/−3
• test/Main.hs +3/−1
• test/Polysemy/Time/GhcTimeTest.hs +4/−1
• test/Polysemy/Time/TimeUnitTest.hs +12/−0

@@ -1,2 +1,6 @@+# 0.2.0.0+* Added `Time.Adjust`, an action that takes a time unit and adds it to the custom start time, if available.+* Added `Fractional` instances for sub-second time units that treat literals as seconds.+ # 0.1.0.0 * initial release

@@ -25,7 +25,7 @@   HasSecond(..),   HasYear(..),   )-import Polysemy.Time.Data.Time (Time(..), now, setDate, setTime, sleep, today)+import Polysemy.Time.Data.Time (Time(..), adjust, now, setDate, setTime, sleep, today) import Polysemy.Time.Data.TimeUnit (   Days(Days),   Hours(Hours),

@@ -6,6 +6,7 @@ import Polysemy.Time.Calendar (HasDate, date, dateToTime) import qualified Polysemy.Time.Data.Time as Time import Polysemy.Time.Data.Time (Time)+import Polysemy.Time.Data.TimeUnit (TimeUnit, addTimeUnit)  -- |Determine the current time adjusted for the difference between a custom instant and the time at which the program -- was started.@@ -24,6 +25,7 @@ interpretTimeAtWithStart ::   ∀ diff t d r a .   Torsor t diff =>+  TimeUnit diff =>   HasDate t d =>   Members [Time t d, Embed IO, State (t, t)] r =>   Sem r a ->@@ -39,6 +41,8 @@     Time.SetTime startAt -> do       startActual <- Time.now @t @d       put @(t, t) (startAt, startActual)+    Time.Adjust diff -> do+      modify' @(t, t) \ (old, actual) -> (addTimeUnit diff old, actual)     Time.SetDate startAt -> do       startActual <- Time.now @t @d       put @(t, t) (dateToTime startAt, startActual)@@ -47,6 +51,7 @@ -- |Interpret 'Time' so that the time when the program starts is @startAt@. interpretTimeAt ::   ∀ (diff :: *) t d r a .+  TimeUnit diff =>   Torsor t diff =>   HasDate t d =>   Members [Time t d, Embed IO] r =>

@@ -0,0 +1,14 @@+module Polysemy.Time.Class.Instant where++import Data.Time (Day, UTCTime(UTCTime))++class Instant i dt | i -> dt where+  dateTime :: i -> dt++instance Instant UTCTime UTCTime where+  dateTime =+    id++instance Instant Day UTCTime where+  dateTime day =+    UTCTime day 0

@@ -1,6 +1,6 @@ module Polysemy.Time.Data.Time where -import Polysemy.Time.Data.TimeUnit (TimeUnit)+import Polysemy.Time.Data.TimeUnit (AddTimeUnit, TimeUnit)  -- |The Time effect. data Time (time :: *) (date :: *) :: Effect where@@ -12,6 +12,8 @@   Sleep :: TimeUnit u => u -> Time t d m ()   -- |Set the current time, if the interpreter supports it.   SetTime :: t -> Time t d m ()+  -- |Adjust the current time relatively, if the interpreter supports it.+  Adjust :: AddTimeUnit t u1 u2 => u1 -> Time t d m ()   -- |Set the current date, if the interpreter supports it.   SetDate :: d -> Time t d m () 

@@ -4,26 +4,35 @@   DiffTime,   NominalDiffTime,   diffTimeToPicoseconds,-  nominalDiffTimeToSeconds,   picosecondsToDiffTime,-  secondsToNominalDiffTime,   )-import Torsor (Additive, Scaling, scale)+import Torsor (Additive, Scaling, Torsor, add, scale) +newtype FromSeconds a =+  FromSeconds a+  deriving (Eq, Show)+  deriving newtype (Num)++instance (Integral a, TimeUnit a) => Fractional (FromSeconds a) where+  fromRational secs =+    FromSeconds (convert (NanoSeconds (round (1e9 * secs))))+  FromSeconds a / FromSeconds b =+    FromSeconds (a `div` b)+ -- |Types that represent an amount of time that can be converted to each other. -- The methods are internal, the API function is 'convert'.-class TimeUnit t where+class TimeUnit u where   nanos :: NanoSeconds -  toNanos :: t -> NanoSeconds-  default toNanos :: Integral t => t -> NanoSeconds-  toNanos t =-    scale (fromIntegral t) (nanos @t)+  toNanos :: u -> NanoSeconds+  default toNanos :: Integral u => u -> NanoSeconds+  toNanos u =+    scale (fromIntegral u) (nanos @u) -  fromNanos :: NanoSeconds -> t-  default fromNanos :: Integral t => NanoSeconds -> t+  fromNanos :: NanoSeconds -> u+  default fromNanos :: Integral u => NanoSeconds -> u   fromNanos n =-    fromIntegral (n `div` (fromIntegral (nanos @t)))+    fromIntegral (n `div` (fromIntegral (nanos @u)))  -- * Data types used to specify time spans, e.g. for sleeping. @@ -86,6 +95,7 @@   MilliSeconds { unMilliSeconds :: Int64 }   deriving (Eq, Show, Generic)   deriving newtype (Num, Real, Enum, Integral, Ord, Additive)+  deriving (Fractional) via (FromSeconds MilliSeconds)  instance TimeUnit MilliSeconds where   nanos =@@ -95,6 +105,7 @@   MicroSeconds { unMicroSeconds :: Int64 }   deriving (Eq, Show, Generic)   deriving newtype (Num, Real, Enum, Integral, Ord, Additive)+  deriving (Fractional) via (FromSeconds MicroSeconds)  instance TimeUnit MicroSeconds where   nanos =@@ -104,6 +115,7 @@   NanoSeconds { unNanoSeconds :: Int64 }   deriving (Eq, Show, Generic)   deriving newtype (Num, Real, Enum, Integral, Ord, Additive)+  deriving (Fractional) via (FromSeconds NanoSeconds)  instance Scaling NanoSeconds Int64 where   scale s (NanoSeconds v) =@@ -129,9 +141,9 @@   nanos =     0   toNanos dt =-    NanoSeconds (divOr0 (fromIntegral (fromEnum (nominalDiffTimeToSeconds dt))) 1000)+    NanoSeconds (divOr0 (fromIntegral (fromEnum dt)) 1000)   fromNanos (NanoSeconds ns) =-    secondsToNominalDiffTime (toEnum (fromIntegral ns) * 1000)+    toEnum (fromIntegral ns) * 1000  -- |Convert between different time spans. --@@ -147,6 +159,18 @@   b convert =   fromNanos . toNanos++type AddTimeUnit t u1 u2 =+  (TimeUnit u1, TimeUnit u2, Torsor t u2)++addTimeUnit ::+  ∀ t u1 u2 .+  AddTimeUnit t u1 u2 =>+  u1 ->+  t ->+  t+addTimeUnit =+  add . convert  defaultJson ''Years defaultJson ''Months

@@ -0,0 +1,17 @@+module Polysemy.Time.Diff where++import Torsor (Torsor, difference)++import Polysemy.Time.Class.Instant (Instant, dateTime)+import Polysemy.Time.Data.TimeUnit (TimeUnit, convert)++diff ::+  TimeUnit u =>+  Torsor dt u =>+  Instant i1 dt =>+  Instant i2 dt =>+  i1 ->+  i2 ->+  u+diff i1 i2 =+  convert (difference (dateTime i1) (dateTime i2))

@@ -34,6 +34,8 @@       embed (threadDelay (fromIntegral us))     Time.SetTime _ ->       unit+    Time.Adjust _ ->+      unit     Time.SetDate _ ->       unit 

@@ -2,14 +2,14 @@  module Polysemy.Time.Orphans where -import Data.Time (secondsToNominalDiffTime, nominalDiffTimeToSeconds, diffUTCTime, addUTCTime, NominalDiffTime, UTCTime)+import Data.Time (diffUTCTime, addUTCTime, NominalDiffTime, UTCTime) import Torsor (Additive(..), Torsor(..))  instance Additive NominalDiffTime where   zero =     0   invert =-    secondsToNominalDiffTime . negate . nominalDiffTimeToSeconds+    toEnum . negate . fromEnum   plus =     (+)   minus =

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-time-version:        0.1.0.0+version:        0.1.1.0 synopsis:       Polysemy effect for time description:    Please see the readme on Github at <https://github.com/tek/polysemy-time> category:       Time@@ -24,9 +24,11 @@       Polysemy.Time       Polysemy.Time.At       Polysemy.Time.Calendar+      Polysemy.Time.Class.Instant       Polysemy.Time.Data.Time       Polysemy.Time.Data.TimeUnit       Polysemy.Time.Debug+      Polysemy.Time.Diff       Polysemy.Time.Ghc       Polysemy.Time.Orphans       Polysemy.Time.Prelude@@ -47,7 +49,7 @@     , containers     , data-default >=0.7 && <0.8     , either-    , polysemy >=1.3.0 && <1.4+    , polysemy >=1.3 && <1.5     , relude >=0.7 && <0.8     , string-interpolate >=0.1 && <0.4     , template-haskell@@ -65,6 +67,7 @@   main-is: Main.hs   other-modules:       Polysemy.Time.GhcTimeTest+      Polysemy.Time.TimeUnitTest       Paths_polysemy_time   hs-source-dirs:       test@@ -78,7 +81,7 @@     , data-default >=0.7 && <0.8     , either     , hedgehog-    , polysemy >=1.3.0 && <1.4+    , polysemy >=1.3 && <1.5     , polysemy-plugin     , polysemy-test     , polysemy-time

@@ -2,13 +2,15 @@  import Polysemy.Test (unitTest) import Polysemy.Time.GhcTimeTest (test_ghcTime, test_ghcTimeAt)+import Polysemy.Time.TimeUnitTest (test_fractional) import Test.Tasty (TestTree, defaultMain, testGroup)  tests :: TestTree tests =   testGroup "unit" [     unitTest "ghc time" test_ghcTime,-    unitTest "ghc time at instant" test_ghcTimeAt+    unitTest "ghc time at instant" test_ghcTimeAt,+    unitTest "convert Fractional to TimeUnit" test_fractional   ]  main :: IO ()

@@ -6,7 +6,7 @@ import Polysemy.Test.Data.Hedgehog (Hedgehog) import Polysemy.Time (Time, mkDatetime, year) import qualified Polysemy.Time.Data.Time as Time-import Polysemy.Time.Data.TimeUnit (Seconds(Seconds))+import Polysemy.Time.Data.TimeUnit (Days(Days), Seconds(Seconds)) import Polysemy.Time.Ghc (interpretTimeGhc, interpretTimeGhcAt)  prog ::@@ -34,3 +34,6 @@       Time.sleep @UTCTime @Day (Seconds 1)       time <- Time.now       1846 === year time+      Time.adjust (Days 366)+      time1 <- Time.now+      1847 === year time1

@@ -0,0 +1,12 @@+module Polysemy.Time.TimeUnitTest where++import Polysemy.Test (UnitTest, runTestAuto, (===))++import Polysemy.Time.Data.TimeUnit (MicroSeconds(MicroSeconds), MilliSeconds(MilliSeconds))++test_fractional :: UnitTest+test_fractional =+  runTestAuto do+    MilliSeconds 50 === 0.05+    MicroSeconds 200 === 0.0002+    MilliSeconds 50 === (MilliSeconds 100 / MilliSeconds 2)