packages feed

polysemy-chronos (empty) → 0.1.0.0

raw patch · 8 files changed

+437/−0 lines, 8 filesdep +aesondep +basedep +chronos

Dependencies added: aeson, base, chronos, containers, hedgehog, polysemy, polysemy-chronos, polysemy-plugin, polysemy-test, polysemy-time, tasty, tasty-hedgehog, text

Files

+ changelog.md view
@@ -0,0 +1,2 @@+# 0.1.0.0+* initial release
+ lib/Polysemy/Chronos.hs view
@@ -0,0 +1,10 @@+{-|+This package provides an interpreter implementation and instances for 'Chronos' of the 'Polysemy.Time' library.+-}+module Polysemy.Chronos (+  -- * Interpreters+  module Polysemy.Chronos.Time,+) where++import Polysemy.Chronos.Orphans ()+import Polysemy.Chronos.Time (ChronosTime, interpretTimeChronos, interpretTimeChronosAt)
+ lib/Polysemy/Chronos/Orphans.hs view
@@ -0,0 +1,146 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Polysemy.Chronos.Orphans where++import qualified Chronos as Chronos+import Chronos (+  Date(Date),+  Datetime(Datetime),+  DayOfMonth(DayOfMonth),+  Month(Month),+  Time,+  TimeOfDay(TimeOfDay),+  Timespan(Timespan),+  Year(Year),+  )+import Prelude hiding (second)++import Polysemy.Time.Calendar (+  Calendar(..),+  HasDate(..),+  HasDay(..),+  HasHour(..),+  HasMinute(..),+  HasMonth(..),+  HasNanoSecond(..),+  HasSecond(..),+  HasYear(..),+  )+import Polysemy.Time.Data.TimeUnit (+  Days(Days),+  Hours(Hours),+  Minutes(Minutes),+  Months(Months),+  NanoSeconds(NanoSeconds),+  TimeUnit(..),+  Years(Years),+  convert,+  )++instance HasDate Time Date where+  date =+    Chronos.datetimeDate . Chronos.timeToDatetime+  dateToTime d =+    Chronos.datetimeToTime (Datetime d (TimeOfDay 0 0 0))++instance HasYear Date where+  year (Date (Chronos.Year y) _ _) =+    Years (fromIntegral y)++instance HasYear Datetime where+  year (Datetime d _) =+    year d++instance HasYear Time where+  year =+    year . Chronos.timeToDatetime++instance HasMonth Date where+  month (Date _ (Chronos.Month m) _) =+    Months (fromIntegral m)++instance HasMonth Datetime where+  month (Datetime d _) =+    month d++instance HasMonth Time where+  month =+    month . Chronos.timeToDatetime++instance HasDay Date where+  day (Date _ _ (Chronos.DayOfMonth d)) =+    Days (fromIntegral d)++instance HasDay Datetime where+  day (Datetime d _) =+    day d++instance HasDay Time where+  day =+    day . Chronos.timeToDatetime++instance HasHour TimeOfDay where+  hour (TimeOfDay h _ _) =+    Hours (fromIntegral h)++instance HasHour Datetime where+  hour (Datetime _ t) =+    hour t++instance HasHour Time where+  hour =+    hour . Chronos.timeToDatetime++instance HasMinute TimeOfDay where+  minute (TimeOfDay _ m _) =+    Minutes (fromIntegral m)++instance HasMinute Datetime where+  minute (Datetime _ t) =+    minute t++instance HasMinute Time where+  minute =+    minute . Chronos.timeToDatetime++instance HasNanoSecond TimeOfDay where+  nanoSecond (TimeOfDay _ _ s) =+    NanoSeconds (fromIntegral s)++instance HasNanoSecond Datetime where+  nanoSecond (Datetime _ t) =+    nanoSecond t++instance HasNanoSecond Time where+  nanoSecond =+    nanoSecond . Chronos.timeToDatetime++instance HasSecond TimeOfDay where+  second t =+    convert (nanoSecond t)++instance HasSecond Datetime where+  second (Datetime _ t) =+    second t++instance HasSecond Time where+  second =+    second . Chronos.timeToDatetime++instance Calendar Datetime where+  type CalendarDate Datetime = Date+  type CalendarTime Datetime = TimeOfDay+  mkDate y m d =+    Date (Year (fromIntegral y)) (Month (fromIntegral m)) (DayOfMonth (fromIntegral d))+  mkTime h m s =+    TimeOfDay (fromIntegral h) (fromIntegral m) (fromIntegral s)+  mkDatetime y mo d h mi s =+    Datetime (mkDate @Datetime y mo d) (mkTime @Datetime h mi s)++instance TimeUnit Timespan where+  nanos =+    1+  toNanos (Timespan ns) =+    NanoSeconds ns+  fromNanos (NanoSeconds ns) =+    Timespan ns
+ lib/Polysemy/Chronos/Time.hs view
@@ -0,0 +1,59 @@+module Polysemy.Chronos.Time where++import qualified Chronos as Chronos+import Chronos (Timespan(Timespan), dateToDay, dayToDate, dayToTimeMidnight, timeToDayTruncate)++import Polysemy.Chronos.Orphans ()+import Polysemy.Time.At (interpretTimeAt)+import qualified Polysemy.Time.Data.Time as Core+import Polysemy.Time.Data.Time (Time)+import Polysemy.Time.Sleep (tSleep)++-- |Convenience alias for 'Chronos'.+type ChronosTime =+  Time Chronos.Time Chronos.Date++now ::+  Member (Embed IO) r =>+  Sem r Chronos.Time+now =+  embed Chronos.now++timeToDate :: Chronos.Time -> Chronos.Date+timeToDate =+  dayToDate . timeToDayTruncate++dateToTime :: Chronos.Date -> Chronos.Time+dateToTime =+  dayToTimeMidnight . dateToDay++-- |Interpret 'Time' with the types from 'Chronos'.+interpretTimeChronos ::+  Member (Embed IO) r =>+  InterpreterFor ChronosTime r+interpretTimeChronos =+  interpret \case+    Core.Now ->+      now+    Core.Today ->+      timeToDate <$> now+    Core.Sleep t ->+      tSleep t+    Core.SetTime _ ->+      unit+    Core.SetDate _ ->+      unit+{-# INLINE interpretTimeChronos #-}++-- |Interpret 'Time' with the types from 'Chronos', customizing the current time at the start of interpretation.+interpretTimeChronosAt ::+  Member (Embed IO) r =>+  Chronos.Time ->+  InterpreterFor ChronosTime r+interpretTimeChronosAt =+  interpretTimeChronos .: interpretTimeAt @Timespan+{-# INLINE interpretTimeChronosAt #-}++negateTimespan :: Timespan -> Timespan+negateTimespan (Timespan t) =+  Timespan (-t)
+ polysemy-chronos.cabal view
@@ -0,0 +1,80 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack++name:           polysemy-chronos+version:        0.1.0.0+synopsis:       Polysemy effect for chronos+description:    Please see the readme on Github at <https://github.com/tek/polysemy-time>+category:       Time+author:         Torsten Schmits+maintainer:     tek@tryp.io+copyright:      2020 Torsten Schmits+license:        BSD-2-Clause-Patent+build-type:     Simple+extra-source-files:+    readme.md+    changelog.md++library+  exposed-modules:+      Polysemy.Chronos+      Polysemy.Chronos.Orphans+      Polysemy.Chronos.Time+      Paths_polysemy_chronos+  autogen-modules:+      Paths_polysemy_chronos+  hs-source-dirs:+      lib+  default-extensions: AllowAmbiguousTypes ApplicativeDo BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DerivingVia DisambiguateRecordFields DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase LiberalTypeSynonyms MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings OverloadedLists PackageImports PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds QuantifiedConstraints QuasiQuotes RankNTypes RecordWildCards RecursiveDo ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators TypeSynonymInstances UndecidableInstances UnicodeSyntax ViewPatterns+  ghc-options: -flate-specialise -fspecialise-aggressively -Wall -fplugin=Polysemy.Plugin+  build-depends:+      aeson >=1.4 && <1.5+    , base >=4 && <5+    , chronos >=1.1.1 && <1.2+    , containers+    , polysemy >=1.3.0 && <1.4+    , polysemy-plugin >=0.2.5 && <0.3+    , polysemy-time+    , text+  mixins:+      base hiding (Prelude)+    , polysemy-time hiding (Polysemy.Time.Prelude)+    , polysemy-time (Polysemy.Time.Prelude as Prelude)+  if impl(ghc < 8.10)+    ghc-options: -O2+  default-language: Haskell2010++test-suite polysemy-chronos-unit+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Polysemy.Chronos.ChronosTimeTest+      Paths_polysemy_chronos+  hs-source-dirs:+      test+  default-extensions: AllowAmbiguousTypes ApplicativeDo BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DerivingVia DisambiguateRecordFields DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase LiberalTypeSynonyms MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings OverloadedLists PackageImports PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds QuantifiedConstraints QuasiQuotes RankNTypes RecordWildCards RecursiveDo ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators TypeSynonymInstances UndecidableInstances UnicodeSyntax ViewPatterns+  ghc-options: -flate-specialise -fspecialise-aggressively -Wall -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N -fplugin=Polysemy.Plugin+  build-depends:+      aeson >=1.4 && <1.5+    , base >=4 && <5+    , chronos >=1.1.1 && <1.2+    , containers+    , hedgehog+    , polysemy >=1.3.0 && <1.4+    , polysemy-chronos+    , polysemy-plugin+    , polysemy-test+    , polysemy-time+    , tasty+    , tasty-hedgehog+    , text+  mixins:+      base hiding (Prelude)+    , polysemy-time hiding (Prelude)+    , polysemy-time (Polysemy.Time.Prelude as Prelude)+  if impl(ghc < 8.10)+    ghc-options: -O2+  default-language: Haskell2010
+ readme.md view
@@ -0,0 +1,89 @@+# About++This Haskell library provides a [Polysemy] effect for accessing the current+time and date and an implementation for [time] and [chronos].++# 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 =>+  Sem r ()+prog = do+  time1 <- Time.now+  Time.sleep (MilliSeconds 10)+  time2 <- Time.now+  print (time1 < time2)+  -- True++testTime :: UTCTime+testTime =+  mkDatetime 1845 12 31 23 59 59++main :: IO ()+main =+  runM do+    interpretTimeChronos prog+    interpretTimeGhcAt testTime do+      Time.sleep (Seconds 1)+      time <- Time.now+      print (year time)+      -- Years { unYear = 1846 }+```++# Effect++The only effect contained in **polysemy-time** is:++```haskell+data Time (time :: *) (date :: *) :: Effect where+  Now :: Time t d m t+  Today :: Time t d m d+  Sleep :: TimeUnit u => u -> Time t d m ()+  SetTime :: t -> Time t d m ()+  SetDate :: d -> Time t d m ()+```++Interpreters are provided for the [time library](time) bundled with GHC and [chronos].++The type parameters correspond to the representations in the implementation,+like `Data.Time.UTCTime`/`Chronos.Time` and `Data.Time.Day`/`Chronos.Date`.++`SetTime` and `SetDate` only have meaning when you're running in a testing context.++A special interpreter variant suffixed with `At` exists for both+implementations, with which the current time is overridden to be relative to+the supplied override fixed at the start of interpretation.+This is useful for testing.++# Utilities++A set of newtypes representing timespans are provided for convenience.+Internally, the interpreters operate on `NanoSecond`s.++The class `TimeUnit` ties those types, and the types `Chronos.Timespan` and+`Data.Time.DiffTime`, together to allow you to convert between them with the+function `convert`:++```haskell+>>> convert (picosecondsToDiffTime 50000000) :: MicroSeconds+MicroSeconds {unMicroSeconds = 50}++>>> convert (Days 5) :: Timespan+Timespan {getTimespan = 432000000000000}+```++The class `Calendar` allows you to construct `UTCTime` and `Chronos.Datetime`+from integers with the function `mkDatetime`, as demonstrated in the first+example.++[Polysemy]: https://hackage.haskell.org/package/polysemy+[time]: https://hackage.haskell.org/package/time+[chronos]: https://hackage.haskell.org/package/chronos
+ test/Main.hs view
@@ -0,0 +1,17 @@+module Main where++import Polysemy.Test (unitTest)+import Test.Tasty (TestTree, defaultMain, testGroup)++import Polysemy.Chronos.ChronosTimeTest (test_chronosTime, test_chronosTimeAt)++tests :: TestTree+tests =+  testGroup "unit" [+    unitTest "chronos time" test_chronosTime,+    unitTest "chronos time at specified instant" test_chronosTimeAt+  ]++main :: IO ()+main =+  defaultMain tests
+ test/Polysemy/Chronos/ChronosTimeTest.hs view
@@ -0,0 +1,34 @@+module Polysemy.Chronos.ChronosTimeTest where++import qualified Chronos as Chronos++import Polysemy.Chronos (interpretTimeChronos)+import Polysemy.Chronos.Time (interpretTimeChronosAt)+import Polysemy.Test (UnitTest, assert, runTestAuto, (===))+import Polysemy.Time.Calendar (year)+import qualified Polysemy.Time.Data.Time as Time+import Polysemy.Time.Data.TimeUnit (Seconds(Seconds))++test_chronosTime :: UnitTest+test_chronosTime =+  runTestAuto do+    interpretTimeChronos do+      time1 <- Time.now+      time2 <- Time.now+      assert (time1 < time2)++testDatetime :: Chronos.Datetime+testDatetime =+  Chronos.datetimeFromYmdhms 1845 12 31 23 59 59++testTime :: Chronos.Time+testTime =+  Chronos.datetimeToTime testDatetime++test_chronosTimeAt :: UnitTest+test_chronosTimeAt =+  runTestAuto do+    interpretTimeChronosAt testTime do+      Time.sleep (Seconds 2)+      time <- Time.now+      1846 === year time