packages feed

pretty-relative-time (empty) → 0.0.0.0

raw patch · 11 files changed

+350/−0 lines, 11 filesdep +QuickCheckdep +basedep +genvalidity-hspecsetup-changed

Dependencies added: QuickCheck, base, genvalidity-hspec, genvalidity-time, hspec, pretty-relative-time, time, validity, validity-time

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for pretty-relative-time++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,7 @@+Copyright 2018 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,1 @@+# pretty-relative-time
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ pretty-relative-time.cabal view
@@ -0,0 +1,67 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: fcebe4c6280960a414497769601af597fefeeb3c20a57aa3617bf5061b1e81b7++name:           pretty-relative-time+version:        0.0.0.0+synopsis:       Pretty relative time+description:    Please see the README on Github at <https://github.com/NorfairKing/pretty-relative-time#readme>+category:       Time+homepage:       https://github.com/NorfairKing/pretty-relative-time#readme+bug-reports:    https://github.com/NorfairKing/pretty-relative-time/issues+author:         Tom Sydney Kerckhove+maintainer:     syd.kerckhove@gmail.com+copyright:      Copyright: (c) 2018 Tom Sydney Kerckhove+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/NorfairKing/pretty-relative-time++library+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , time+    , validity+    , validity-time+  exposed-modules:+      Text.Time.Pretty+      Text.Time.Pretty.Constants+      Text.Time.Pretty.Render+      Text.Time.Pretty.TimeAgo+  other-modules:+      Paths_pretty_relative_time+  default-language: Haskell2010++test-suite pretty-relative-time-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      QuickCheck+    , base >=4.7 && <5+    , genvalidity-hspec+    , genvalidity-time+    , hspec+    , pretty-relative-time+    , time+    , validity+    , validity-time+  other-modules:+      Text.Time.PrettySpec+      Paths_pretty_relative_time+  default-language: Haskell2010
+ src/Text/Time/Pretty.hs view
@@ -0,0 +1,30 @@+module Text.Time.Pretty+    ( prettyTimeAutoFromNow+    , prettyTimeAuto+    -- Helper functions+    , timeAgo+    , timeAgoToDiffTime+    -- * Helper Types+    , TimeAgo(..)+    -- * Rendering+    , renderTimeAgoAuto+    -- * Constants+    , picoSecondsPerSecond+    , secondsPerMinute+    , minutesPerHour+    , hoursPerDay+    ) where++import Data.Time++import Text.Time.Pretty.Constants+import Text.Time.Pretty.Render+import Text.Time.Pretty.TimeAgo++prettyTimeAutoFromNow :: UTCTime -> IO String+prettyTimeAutoFromNow before = do+    now <- getCurrentTime+    pure $ prettyTimeAuto now before++prettyTimeAuto :: UTCTime -> UTCTime -> String+prettyTimeAuto now before = renderTimeAgoAuto $ timeAgo $ diffUTCTime now before
+ src/Text/Time/Pretty/Constants.hs view
@@ -0,0 +1,18 @@+module Text.Time.Pretty.Constants+    ( picoSecondsPerSecond+    , secondsPerMinute+    , minutesPerHour+    , hoursPerDay+    ) where++picoSecondsPerSecond :: Integral a => a+picoSecondsPerSecond = 10 ^ (12 :: Integer)++secondsPerMinute :: Integral a => a+secondsPerMinute = 60++minutesPerHour :: Integral a => a+minutesPerHour = 60++hoursPerDay :: Integral a => a+hoursPerDay = 24
+ src/Text/Time/Pretty/Render.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE RecordWildCards #-}++module Text.Time.Pretty.Render+    ( renderTimeAgoAuto+    ) where++import Text.Time.Pretty.TimeAgo++renderTimeAgoAuto :: TimeAgo -> String+renderTimeAgoAuto TimeAgo {..} =+    case signAgo of+        GT ->+            if | daysAgo > 0 ->+                   unwords [show daysAgo, plural daysAgo "day" "days", "ago"]+               | hoursAgo > 0 ->+                   unwords+                       [show hoursAgo, plural hoursAgo "hour" "hours", "ago"]+               | minutesAgo > 0 ->+                   unwords+                       [ show minutesAgo+                       , plural minutesAgo "minute" "minutes"+                       , "ago"+                       ]+               | secondsAgo > 0 ->+                   unwords+                       [ show secondsAgo+                       , plural secondsAgo "second" "seconds"+                       , "ago"+                       ]+               | otherwise -> "just now"+        EQ -> "just now"+        LT ->+            if | daysAgo > 0 ->+                   unwords ["in", show daysAgo, plural daysAgo "day" "days"]+               | hoursAgo > 0 ->+                   unwords ["in", show hoursAgo, plural hoursAgo "hour" "hours"]+               | minutesAgo > 0 ->+                   unwords+                       [ "in"+                       , show minutesAgo+                       , plural minutesAgo "minute" "minutes"+                       ]+               | secondsAgo > 0 ->+                   unwords+                       [ "in"+                       , show secondsAgo+                       , plural secondsAgo "second" "seconds"+                       ]+               | otherwise -> "just now"++plural :: Integral a => a -> String -> String -> String+plural 1 sing _ = sing+plural _ _ plur = plur
+ src/Text/Time/Pretty/TimeAgo.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}++module Text.Time.Pretty.TimeAgo+    ( timeAgo+    , timeAgoToDiffTime+    , TimeAgo(..)+    ) where++import Data.Time+import Data.Validity+import GHC.Generics (Generic)++import Text.Time.Pretty.Constants++data TimeAgo = TimeAgo+    { signAgo :: Ordering+    , daysAgo :: Integer+    , hoursAgo :: Integer+    , minutesAgo :: Integer+    , secondsAgo :: Integer+    , picoSecondsAgo :: Integer+    } deriving (Show, Eq, Generic)++instance Validity TimeAgo where+    isValid = isValidByValidating+    validate TimeAgo {..} =+        mconcat+            [ (case signAgo of+                   EQ ->+                       and+                           [ daysAgo == 0+                           , hoursAgo == 0+                           , minutesAgo == 0+                           , secondsAgo == 0+                           , picoSecondsAgo == 0+                           ]+                   _ ->+                       any+                           (> 0)+                           [ daysAgo+                           , hoursAgo+                           , minutesAgo+                           , secondsAgo+                           , picoSecondsAgo+                           ]) <?@>+              "the sign makes sense"+            , (daysAgo >= 0) <?@> "days are positive"+            , (hoursAgo < hoursPerDay) <?@> "hours < 24"+            , (hoursAgo >= 0) <?@> "hours are positive"+            , (minutesAgo < minutesPerHour) <?@> "minutes < 60"+            , (minutesAgo >= 0) <?@> "minutes are positive"+            , (secondsAgo < secondsPerMinute) <?@> "seconds < 60"+            , (secondsAgo >= 0) <?@> "seconds are positive"+            , (picoSecondsAgo < picoSecondsPerSecond) <?@> "picoseconds < 1E12"+            , (picoSecondsAgo >= 0) <?@> "picoseconds are positive"+            ]++timeAgo :: NominalDiffTime -> TimeAgo+timeAgo dt = TimeAgo {..}+  where+    signAgo = compare dt 0+    picoSecondsAgo =+        totalPicoSecondsAgo - picoSecondsPerSecond * totalSecondsAgo+    secondsAgo = totalSecondsAgo - secondsPerMinute * totalMinutesAgo+    minutesAgo = totalMinutesAgo - minutesPerHour * totalHoursAgo+    hoursAgo = totalHoursAgo - hoursPerDay * totalDaysAgo+    daysAgo = totalDaysAgo+    totalPicoSecondsAgo =+        floor $ absDt * fromIntegral (picoSecondsPerSecond :: Integer)+    totalSecondsAgo = floor absDt :: Integer+    totalMinutesAgo = floor $ absDt / fromIntegral (secondsPerMinute :: Integer)+    totalHoursAgo =+        floor $+        absDt / fromIntegral (minutesPerHour * secondsPerMinute :: Integer)+    totalDaysAgo =+        floor $+        absDt /+        fromIntegral+            (hoursPerDay * minutesPerHour * secondsPerMinute :: Integer)+    absDt = abs dt++timeAgoToDiffTime :: TimeAgo -> NominalDiffTime+timeAgoToDiffTime TimeAgo {..} =+    (/ fromIntegral (picoSecondsPerSecond :: Integer)) $+    realToFrac $+    (case signAgo of+         EQ -> const 0+         GT -> id+         LT -> negate)+        (picoSecondsAgo ++         picoSecondsPerSecond *+         (secondsAgo + 60 * (minutesAgo + 60 * (hoursAgo + 24 * daysAgo))))
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Text/Time/PrettySpec.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.Time.PrettySpec+    ( spec+    ) where++import Data.GenValidity.Time ()+import Test.Hspec+import Test.QuickCheck+import Test.Validity++import Text.Time.Pretty++instance GenUnchecked TimeAgo++instance GenValid TimeAgo where+    genValid = do+        sign <- genValid+        case sign of+            EQ -> pure $ TimeAgo EQ 0 0 0 0 0+            _ ->+                (TimeAgo sign <$> choose (0, picoSecondsPerSecond) <*>+                 choose (0, secondsPerMinute) <*>+                 choose (0, minutesPerHour) <*>+                 choose (0, hoursPerDay) <*>+                 (abs <$> genValid)) `suchThat`+                isValid++spec :: Spec+spec = do+    eqSpec @TimeAgo+    genValidSpec @TimeAgo+    describe "timeAgo" $ do+        it "produces valid TimeAgo's" $ producesValidsOnValids timeAgo+        it "is the inverse of timeAgoToDiffTime" $+            inverseFunctionsOnValid timeAgo timeAgoToDiffTime+    describe "timeAgoToDiffTime" $ do+        it "produces valid DiffTime's" $ producesValidsOnValids timeAgo+        it "is the inverse of timeAgo for just picoseconds" $+            inverseFunctionsOnGen+                timeAgoToDiffTime+                timeAgo+                ((TimeAgo GT 0 0 0 0 <$> genValid) `suchThat` isValid)+                (const [])+        it "is the inverse of timeAgo" $+            inverseFunctionsOnValid timeAgoToDiffTime timeAgo+    describe "renderTimeAgoAuto" $ do+        it "produces valid Strings's" $ producesValidsOnValids renderTimeAgoAuto+        it "renders these simple examples well" $ do+            renderTimeAgoAuto (TimeAgo GT 5 0 0 0 0) `shouldBe` "5 days ago"+            renderTimeAgoAuto (TimeAgo GT 0 6 0 0 0) `shouldBe` "6 hours ago"+            renderTimeAgoAuto (TimeAgo GT 0 0 7 0 0) `shouldBe` "7 minutes ago"+            renderTimeAgoAuto (TimeAgo GT 0 0 0 8 0) `shouldBe` "8 seconds ago"+            renderTimeAgoAuto (TimeAgo GT 0 0 0 0 9) `shouldBe` "just now"+            renderTimeAgoAuto (TimeAgo EQ 0 0 0 0 0) `shouldBe` "just now"+            renderTimeAgoAuto (TimeAgo LT 5 0 0 0 0) `shouldBe` "in 5 days"+            renderTimeAgoAuto (TimeAgo LT 0 6 0 0 0) `shouldBe` "in 6 hours"+            renderTimeAgoAuto (TimeAgo LT 0 0 7 0 0) `shouldBe` "in 7 minutes"+            renderTimeAgoAuto (TimeAgo LT 0 0 0 8 0) `shouldBe` "in 8 seconds"+            renderTimeAgoAuto (TimeAgo LT 0 0 0 0 9) `shouldBe` "just now"+        it "handles singular nouns well" $ do+            renderTimeAgoAuto (TimeAgo GT 1 0 0 0 0) `shouldBe` "1 day ago"+            renderTimeAgoAuto (TimeAgo GT 0 1 0 0 0) `shouldBe` "1 hour ago"+            renderTimeAgoAuto (TimeAgo GT 0 0 1 0 0) `shouldBe` "1 minute ago"+            renderTimeAgoAuto (TimeAgo GT 0 0 0 1 0) `shouldBe` "1 second ago"+            renderTimeAgoAuto (TimeAgo GT 0 0 0 0 1) `shouldBe` "just now"+            renderTimeAgoAuto (TimeAgo EQ 0 0 0 0 0) `shouldBe` "just now"+            renderTimeAgoAuto (TimeAgo LT 1 0 0 0 0) `shouldBe` "in 1 day"+            renderTimeAgoAuto (TimeAgo LT 0 1 0 0 0) `shouldBe` "in 1 hour"+            renderTimeAgoAuto (TimeAgo LT 0 0 1 0 0) `shouldBe` "in 1 minute"+            renderTimeAgoAuto (TimeAgo LT 0 0 0 1 0) `shouldBe` "in 1 second"+            renderTimeAgoAuto (TimeAgo LT 0 0 0 0 1) `shouldBe` "just now"