polysemy-time 0.2.0.3 → 0.3.0.0

raw patch · 10 files changed

+67/−264 lines, 10 filesdep +incipit-coredep +stmdep −polysemydep −reludedep −textsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: incipit-core, stm

Dependencies removed: polysemy, relude, text

API changes (from Hackage documentation)

Files

• Setup.hs +2/−0
• lib/Polysemy/Time/At.hs +4/−4
• lib/Polysemy/Time/Data/Time.hs +0/−2
• lib/Polysemy/Time/Data/TimeUnit.hs +35/−10
• lib/Polysemy/Time/Debug.hs +0/−102
• lib/Polysemy/Time/Json.hs +14/−0
• lib/Polysemy/Time/Prelude.hs +0/−116
• lib/Prelude.hs +0/−8
• polysemy-time.cabal +6/−16
• readme.md +6/−6

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

@@ -1,7 +1,7 @@ -- |Interceptors for fixing a specific time, Internal module Polysemy.Time.At where -import Polysemy (intercept)+import Control.Concurrent.STM (newTVarIO) import Torsor (Torsor (add), difference)  import Polysemy.Time.Calendar (HasDate, date, dateToTime)@@ -61,7 +61,7 @@   Sem r a interceptTimeAt startAt sem = do   startActual <- Time.now @t @d-  tv <- newTVarIO (startAt, startActual)+  tv <- embed (newTVarIO (startAt, startActual))   runAtomicStateTVar tv . interceptTimeAtWithStart @diff @t @d . raise $ sem {-# inline interceptTimeAt #-} @@ -100,7 +100,7 @@   Sem r a ->   Sem r a interceptTimeConstant startAt sem = do-  tv <- newTVarIO startAt+  tv <- embed (newTVarIO startAt)   runAtomicStateTVar tv . interceptTimeConstantState @t . raise $ sem {-# inline interceptTimeConstant #-} @@ -115,6 +115,6 @@   Sem r a interceptTimeConstantNow sem = do   now <- Time.now @t @d-  tv <- newTVarIO now+  tv <- embed (newTVarIO now)   runAtomicStateTVar tv . interceptTimeConstantState @t . raise $ sem {-# inline interceptTimeConstantNow #-}

@@ -3,8 +3,6 @@ -- |Time effect, Internal module Polysemy.Time.Data.Time where -import Polysemy (makeSem_)- import Polysemy.Time.Data.TimeUnit (AddTimeUnit, TimeUnit)  -- |The Time effect.

@@ -1,6 +1,7 @@ -- |TimeUnit Class and Data Types, Internal module Polysemy.Time.Data.TimeUnit where +import Data.Fixed (div') import Data.Time (   DiffTime,   NominalDiffTime,@@ -9,6 +10,8 @@   ) import Torsor (Additive, Scaling, Torsor, add, scale) +import Polysemy.Time.Json (json)+ -- |For deriving via. newtype FromSeconds a =   FromSeconds a@@ -142,6 +145,28 @@   fromNanos =     id +safeDiv ::+  Real a =>+  Integral a =>+  a ->+  a ->+  Maybe a+safeDiv _ 0 =+  Nothing+safeDiv n d =+  Just (n `div'` d)+{-# inline safeDiv #-}++divOr0 ::+  Real a =>+  Integral a =>+  a ->+  a ->+  a+divOr0 l r =+  fromMaybe 0 (safeDiv l r)+{-# inline divOr0 #-}+ instance TimeUnit DiffTime where   nanos =     0@@ -195,13 +220,13 @@ secondsFrac u =   fromIntegral (unNanoSeconds (convert u)) / 1e9 -defaultJson ''Years-defaultJson ''Months-defaultJson ''Weeks-defaultJson ''Days-defaultJson ''Hours-defaultJson ''Minutes-defaultJson ''Seconds-defaultJson ''MilliSeconds-defaultJson ''MicroSeconds-defaultJson ''NanoSeconds+json ''Years+json ''Months+json ''Weeks+json ''Days+json ''Hours+json ''Minutes+json ''Seconds+json ''MilliSeconds+json ''MicroSeconds+json ''NanoSeconds

@@ -1,102 +0,0 @@-{-# language NoImplicitPrelude #-}-{-# options_haddock prune, hide #-}---- |Debug printing, Internal-module Polysemy.Time.Debug where--import qualified Data.Text as Text-import GHC.Stack (SrcLoc (..))-import Relude-import System.IO.Unsafe (unsafePerformIO)--srcLoc :: CallStack -> SrcLoc-srcLoc = \case-  (getCallStack -> (_, loc) : _) -> loc-  _ -> error "Debug.srcLoc: empty CallStack"--debugPrint ::-  SrcLoc ->-  Text ->-  IO ()-debugPrint SrcLoc{ srcLocModule = (toText -> slm), ..} msg =-  putStrLn (toString moduleName <> ":" <> show srcLocStartLine <> " " <> toString msg)-  where-    moduleName =-      fromMaybe slm $ listToMaybe $ reverse $ Text.splitOn "." slm--debugPrintWithLoc ::-  Monad m =>-  SrcLoc ->-  Text ->-  m ()-debugPrintWithLoc loc msg = do-  () <- return (unsafePerformIO (debugPrint loc msg))-  pure ()--dbg ::-  HasCallStack =>-  Monad m =>-  Text ->-  m ()-dbg =-  debugPrintWithLoc (srcLoc callStack)-{-# inline dbg #-}--dbgsWith ::-  HasCallStack =>-  Monad m =>-  Show a =>-  Text ->-  a ->-  m ()-dbgsWith prefix a =-  debugPrintWithLoc (srcLoc callStack) (prefix <> ": " <> show a)-{-# inline dbgsWith #-}--dbgs ::-  HasCallStack =>-  Monad m =>-  Show a =>-  a ->-  m ()-dbgs a =-  debugPrintWithLoc (srcLoc callStack) (show a)-{-# inline dbgs_ #-}--dbgs_ ::-  HasCallStack =>-  Monad m =>-  Show a =>-  a ->-  m a-dbgs_ a =-  a <$ debugPrintWithLoc (srcLoc callStack) (show a)-{-# inline dbgs #-}--tr ::-  HasCallStack =>-  Text ->-  a ->-  a-tr msg a =-  unsafePerformIO (a <$ debugPrint (srcLoc callStack) msg)-{-# inline tr #-}--trs ::-  Show a =>-  HasCallStack =>-  a ->-  a-trs a =-  unsafePerformIO (a <$ debugPrint (srcLoc callStack) (show a))-{-# inline trs #-}--trs' ::-  Show b =>-  HasCallStack =>-  b ->-  a ->-  a-trs' b a =-  unsafePerformIO (a <$ debugPrint (srcLoc callStack) (show b))-{-# inline trs' #-}

@@ -0,0 +1,14 @@+-- |Aeson derivation combinator, internal+module Polysemy.Time.Json where++import qualified Data.Aeson as Aeson+import Data.Aeson.TH (deriveJSON)+import qualified Language.Haskell.TH.Syntax as TH++-- |Derive Aeson codecs with custom settings.+json :: TH.Name -> TH.Q [TH.Dec]+json =+  deriveJSON Aeson.defaultOptions {+    Aeson.fieldLabelModifier = dropWhile ('_' ==),+    Aeson.unwrapUnaryRecords = True+  }

@@ -1,116 +0,0 @@-{-# language NoImplicitPrelude #-}-{-# options_haddock prune, hide #-}---- |Prelude, Internal-module Polysemy.Time.Prelude (-  module Polysemy.Time.Prelude,-  module Data.Foldable,-  module Data.Kind,-  module GHC.Err,-  module Polysemy,-  module Polysemy.AtomicState,-  module Polysemy.Time.Debug,-  module Relude,-) where--import qualified Data.Aeson as Aeson-import Data.Aeson.TH (deriveJSON)-import Data.Fixed (div')-import Data.Foldable (traverse_)-import Data.Kind (Type)-import GHC.Err (undefined)-import qualified Language.Haskell.TH.Syntax as TH-import Polysemy (-  Effect,-  EffectRow,-  Embed,-  Final,-  InterpreterFor,-  Member,-  Members,-  Sem,-  WithTactics,-  embed,-  embedToFinal,-  interpret,-  makeSem,-  pureT,-  raise,-  raiseUnder,-  raiseUnder2,-  raiseUnder3,-  reinterpret,-  runFinal,-  )-import Polysemy.AtomicState (AtomicState, atomicGet, atomicGets, atomicModify', atomicPut, runAtomicStateTVar)-import Relude hiding (-  Reader,-  State,-  Sum,-  Type,-  ask,-  asks,-  evalState,-  filterM,-  get,-  gets,-  hoistEither,-  modify,-  modify',-  put,-  readFile,-  runReader,-  runState,-  state,-  trace,-  traceShow,-  undefined,-  )--import Polysemy.Time.Debug (dbg, dbgs, dbgs_)--unit ::-  Applicative f =>-  f ()-unit =-  pure ()-{-# inline unit #-}--basicOptions :: Aeson.Options-basicOptions =-  Aeson.defaultOptions {-    Aeson.fieldLabelModifier = dropWhile ('_' ==)-  }--jsonOptions :: Aeson.Options-jsonOptions =-  basicOptions {-    Aeson.unwrapUnaryRecords = True-  }--defaultJson :: TH.Name -> TH.Q [TH.Dec]-defaultJson =-  deriveJSON jsonOptions-{-# inline defaultJson #-}--safeDiv ::-  Real a =>-  Integral a =>-  a ->-  a ->-  Maybe a-safeDiv _ 0 =-  Nothing-safeDiv n d =-  Just (n `div'` d)-{-# inline safeDiv #-}--divOr0 ::-  Real a =>-  Integral a =>-  a ->-  a ->-  a-divOr0 l r =-  fromMaybe 0 (safeDiv l r)-{-# inline divOr0 #-}

@@ -1,8 +0,0 @@-{-# options_haddock prune, hide #-}---- |Prelude, Internal-module Prelude (-  module Polysemy.Time.Prelude,-) where--import Polysemy.Time.Prelude

@@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.34.6. -- -- see: https://github.com/sol/hpack  name:           polysemy-time-version:        0.2.0.3+version:        0.3.0.0 synopsis:       Polysemy Effect for Time description:    Please see the readme on Github at <https://github.com/tek/polysemy-time> category:       Time@@ -27,19 +27,13 @@       Polysemy.Time.Class.Instant       Polysemy.Time.Data.Time       Polysemy.Time.Data.TimeUnit-      Polysemy.Time.Debug       Polysemy.Time.Diff       Polysemy.Time.Ghc+      Polysemy.Time.Json       Polysemy.Time.Loop       Polysemy.Time.Measure       Polysemy.Time.Orphans-      Polysemy.Time.Prelude       Polysemy.Time.Sleep-  other-modules:-      Prelude-      Paths_polysemy_time-  autogen-modules:-      Paths_polysemy_time   hs-source-dirs:       lib   default-extensions:@@ -104,10 +98,9 @@   build-depends:       aeson >=1.4     , base ==4.*-    , polysemy >=1.4-    , relude >=0.7+    , incipit-core >=0.1+    , stm     , template-haskell-    , text     , time     , torsor >=0.1   mixins:@@ -121,7 +114,6 @@       Polysemy.Time.Test.GhcTimeTest       Polysemy.Time.Test.MeasureTest       Polysemy.Time.Test.TimeUnitTest-      Paths_polysemy_time   hs-source-dirs:       test   default-extensions:@@ -185,13 +177,11 @@   ghc-options: -flate-specialise -fspecialise-aggressively -Wall -Wredundant-constraints -Wunused-packages -threaded -rtsopts -with-rtsopts=-N   build-depends:       base ==4.*-    , polysemy >=1.3+    , incipit-core     , polysemy-test     , polysemy-time     , tasty     , time   mixins:       base hiding (Prelude)-    , polysemy-time hiding (Polysemy.Time.Prelude)-    , polysemy-time (Polysemy.Time.Prelude as Prelude)   default-language: Haskell2010

@@ -1,20 +1,19 @@ # About -This Haskell library provides a [Polysemy] effect for accessing the current-time and date and an implementation for [time] and [chronos].+This Haskell library provides a [Polysemy] effect for accessing the current time and date, and interpreters using+[time].  # Example  ```haskell import Data.Time (UTCTime) import Polysemy (Members, runM)-import Polysemy.Chronos (interpretTimeChronos) import qualified Polysemy.Time as Time import Polysemy.Time (MilliSeconds(MilliSeconds), Seconds(Seconds), Time, interpretTimeGhcAt, mkDatetime, year)  prog ::   Ord t =>-  Member (Time t d) r =>+  Members [Time t d, Embed IO] r =>   Sem r () prog = do   time1 <- Time.now@@ -30,7 +29,6 @@ main :: IO () main =   runM do-    interpretTimeChronos prog     interpretTimeGhcAt testTime do       Time.sleep (Seconds 1)       time <- Time.now@@ -51,7 +49,8 @@   SetDate :: d -> Time t d m () ``` -Interpreters are provided for the [time library](time) bundled with GHC and [chronos].+Interpreters are provided for the [time library](time) bundled with GHC.+The project [polysemy-chronos] contains an alternative implementation for [chronos].  The type parameters correspond to the representations in the implementation, like `Data.Time.UTCTime`/`Chronos.Time` and `Data.Time.Day`/`Chronos.Date`.@@ -87,3 +86,4 @@ [Polysemy]: https://hackage.haskell.org/package/polysemy [time]: https://hackage.haskell.org/package/time [chronos]: https://hackage.haskell.org/package/chronos+[polysemy-chronos]: https://hackage.haskell.org/package/polysemy-chronos