diff --git a/.gitignore b/.gitignore index 178135c..d454c6b 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,3 @@ /dist/ +dump/ +.stack-work/ diff --git a/src/Control/Monad/Thyme.hs b/src/Control/Monad/Thyme.hs new file mode 100644 index 0000000..d9694c5 --- /dev/null +++ b/src/Control/Monad/Thyme.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +#if __GLASGOW_HASKELL__ < 710 +{-# LANGUAGE OverlappingInstances #-} +#endif + +module Control.Monad.Thyme + ( MonadTime(..) + ) where + +import Control.Monad.Trans +import Data.Thyme + +-- | Class of monads which carry the notion of the current time. +class Monad m => MonadTime m where + currentTime :: m UTCTime + +-- | Base instance for IO. +instance {-# OVERLAPPING #-} MonadTime IO where + currentTime = getCurrentTime + +-- | Generic, overlappable instance. +instance {-# OVERLAPPABLE #-} (MonadTime m, MonadTrans t, Monad (t m)) => MonadTime (t m) where + currentTime = lift currentTime diff --git a/src/Data/Thyme/Clock/TAI.hs b/src/Data/Thyme/Clock/TAI.hs index 336d81d..3946202 100644 --- a/src/Data/Thyme/Clock/TAI.hs +++ b/src/Data/Thyme/Clock/TAI.hs @@ -53,6 +53,9 @@ import Data.Hashable import Data.Ix import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mempty) +#endif import Data.Thyme.Calendar import Data.Thyme.Clock.Internal import Data.Thyme.Format.Internal (indexOf) @@ -354,4 +357,3 @@ utcToTAITime = view . absoluteTime {-# INLINE taiToUTCTime #-} taiToUTCTime :: TAIUTCMap -> AbsoluteTime -> UTCTime taiToUTCTime = review . absoluteTime - diff --git a/src/Data/Thyme/Format.hs b/src/Data/Thyme/Format.hs index 207dee9..9b1258c 100644 --- a/src/Data/Thyme/Format.hs +++ b/src/Data/Thyme/Format.hs @@ -39,6 +39,9 @@ import Data.Bits import qualified Data.ByteString.Char8 as S import Data.Char import Data.Int +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mempty) +#endif import Data.Thyme.Internal.Micro import Data.Thyme.Calendar import Data.Thyme.Calendar.Internal @@ -985,4 +988,3 @@ timeZoneParser = zone "TAI" 0 False <|> zone "UT1" 0 False zone name offset dst = TimeZone offset dst name <$ P.string (S.pack name) ($+) h m = h * 60 + m ($-) h m = negate (h * 60 + m) - diff --git a/tests/Monad.hs b/tests/Monad.hs new file mode 100644 index 0000000..9d9a78a --- /dev/null +++ b/tests/Monad.hs @@ -0,0 +1,10 @@ +import Control.Monad.Reader (runReaderT) +import Control.Monad.State (evalStateT) +import Control.Monad.Thyme (currentTime) + +main :: IO () +main = do + currentTime >>= print + -- Test that generic MonadTrans instance works. + runReaderT currentTime 'x' >>= print + evalStateT (runReaderT currentTime 'x') 'y' >>= print diff --git a/tests/sanity.hs b/tests/sanity.hs index 466860e..9409550 100644 --- a/tests/sanity.hs +++ b/tests/sanity.hs @@ -7,6 +7,9 @@ import Prelude +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif import Control.Arrow import Control.Lens import qualified Data.Attoparsec.ByteString.Char8 as P @@ -95,4 +98,3 @@ main = exit . all isSuccess =<< sequence isSuccess r = case r of Success {} -> True; _ -> False qc :: Testable prop => Int -> prop -> IO Result qc n = quickCheckWithResult stdArgs {maxSuccess = n, maxSize = n} - diff --git a/thyme.cabal b/thyme.cabal index e12ee98..6141456 100644 --- a/thyme.cabal +++ b/thyme.cabal @@ -1,5 +1,5 @@ name: thyme -version: 0.3.5.5 +version: 0.3.5.6 synopsis: A faster time library description: @thyme@ is a performance-optimized rewrite of the excellent @@ -60,6 +60,7 @@ library if !(flag(lens) || flag(docs)) hs-source-dirs: lens exposed-modules: + Control.Monad.Thyme Data.Thyme Data.Thyme.Docs Data.Thyme.Calendar @@ -167,6 +168,17 @@ test-suite hlint else buildable: False +test-suite monad + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Monad.hs + build-depends: + base, + mtl, + thyme + ghc-options: -Wall + benchmark bench default-language: Haskell2010 type: exitcode-stdio-1.0 @@ -195,4 +207,3 @@ benchmark bench ghc-options: -Wall -- vim: et sw=4 ts=4 sts=4: -