Feature/control monad thyme

.gitignore

@@ -1 +1,3 @@
 /dist/
+dump/
+.stack-work/

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

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
-

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)
-

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

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}
-

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:
-