LocalPreciseDateTime improvements (#20)

* add diff for LocalPreciseDateTime

* fix LocalPreciseDateTime.fromRFC3339String

* turns out the problem was with toRFC3339String...

* do not let javascript parser normalise locale-specified datetime values

* guard against invalid locales

* fix it

* distinguish between missing locale and bad locale

* remove unsafePartial

* add tests

* rename function again

* add no-op PreciseDuration conversion cases

* fix import error

src/Data/PreciseDateTime/Locale.purs

@@ -2,27 +2,36 @@ module Data.PreciseDateTime.Locale where
 
 import Prelude
 
-import Data.DateTime.Locale (LocalValue(..), LocalDateTime)
+import Data.DateTime.Locale (Locale(..), LocalValue(..), LocalDateTime)
+import Data.Decimal as Decimal
 import Data.Maybe (Maybe)
+import Data.Newtype (unwrap)
 import Data.PreciseDateTime (PreciseDateTime)
 import Data.PreciseDateTime as PDT
 import Data.RFC3339String (RFC3339String(..))
 import Data.RFC3339String as RFC3339String
 import Data.RFC3339String.Format (formatLocale)
 import Data.String (dropRight)
 import Data.Time.PreciseDuration (PreciseDuration)
+import Data.Time.PreciseDuration as PD
 import Data.Traversable (traverse)
 
 type LocalPreciseDateTime = LocalValue PreciseDateTime
 
 adjust :: PreciseDuration -> LocalPreciseDateTime -> Maybe LocalPreciseDateTime
 adjust = traverse <<< PDT.adjust
 
+diff :: LocalPreciseDateTime -> LocalPreciseDateTime -> PreciseDuration
+diff (LocalValue (Locale _ m1) pdt1) (LocalValue (Locale _ m2) pdt2) =
+  let offsetDiff = PD.toDecimalLossy (PD.toNanoseconds (PD.minutes (Decimal.fromNumber (unwrap (m1 - m2)))))
+      dtDiff = PD.toDecimalLossy (PD.toNanoseconds (PDT.diff pdt1 pdt2))
+  in PD.unsafeNanoseconds (offsetDiff + dtDiff)
+
 fromRFC3339String :: RFC3339String -> Maybe LocalPreciseDateTime
 fromRFC3339String = do
   loc <- RFC3339String.toLocale
-  pdt <- PDT.fromRFC3339String
-  pure $ LocalValue loc <$> pdt
+  pdt <- PDT.fromRFC3339String <<< RFC3339String.setLocaleToZ
+  pure $ LocalValue <$> loc <*> pdt
 
 toRFC3339String :: LocalPreciseDateTime -> RFC3339String
 toRFC3339String (LocalValue locale pdt) =

src/Data/RFC3339String.purs

@@ -2,6 +2,7 @@ module Data.RFC3339String where
 
 import Prelude
 
+import Control.MonadZero (guard)
 import Control.Monad.Eff (Eff, runPure)
 import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
 import Data.DateTime (DateTime)
@@ -16,8 +17,9 @@ import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype (class Newtype, unwrap)
 import Data.RFC3339String.Format (iso8601Format)
 import Data.String as String
-import Data.String.Regex (match, regex) as RE
+import Data.String.Regex (match, regex, replace) as RE
 import Data.String.Regex.Flags (noFlags) as RE
+import Data.String.Regex.Unsafe (unsafeRegex) as RE
 import Data.Time.Duration (Hours(..), Minutes(..), convertDuration)
 import Data.Traversable (sequence)
 import Data.Tuple (Tuple(..), snd)
@@ -51,15 +53,26 @@ fromDateTime :: DateTime -> RFC3339String
 fromDateTime = trim <<< RFC3339String <<< format iso8601Format
 
 -- | Reads the locale, returning GMT (+0000) if not present.
-toLocale :: RFC3339String -> Locale
-toLocale (RFC3339String s) = Locale Nothing $ fromMaybe zero $ unsafePartial $ do
+-- Fails with 'Nothing' if the numbers specified are out of range.
+toLocale :: RFC3339String -> Maybe Locale
+toLocale (RFC3339String s) = unsafePartial $ Locale Nothing <$> do
   re <- hush $ RE.regex "([-|\\+])(\\d\\d):?(\\d\\d)$" RE.noFlags
-  [_, sign, hrs, mins] <- sequence =<< RE.match re s
-  let readNum = map toNumber <<< fromString
-  hrs' <- readNum hrs
-  mins' <- readNum mins
-  let offset = convertDuration (Hours hrs') + Minutes mins'
-  pure $ (if sign == "-" then negate else id) offset
+  case sequence =<< RE.match re s of
+    Nothing -> pure zero -- GMT
+    Just [_, sign, hrs, mins] -> do
+      let readNum = map toNumber <<< fromString
+      hrs' <- readNum hrs
+      mins' <- readNum mins
+      guard $ zero <= hrs' && hrs' <= 24.0
+      guard $ if hrs' == 24.0 then mins' == zero else zero <= mins' && mins' <= 59.0
+      let offset = convertDuration (Hours hrs') + Minutes mins'
+      pure $ (if sign == "-" then negate else id) offset
+
+-- | Strips the locale, normalising it to GMT.
+setLocaleToZ :: RFC3339String -> RFC3339String
+setLocaleToZ (RFC3339String s) =
+  let re = RE.unsafeRegex "([-|\\+])(\\d\\d):?(\\d\\d)$" RE.noFlags
+  in RFC3339String (RE.replace re "Z" s)
 
 toDateTime :: RFC3339String -> Maybe DateTime
 toDateTime = JSDate.toDateTime <<< unsafeParse <<< unwrap

src/Data/Time/PreciseDuration.purs

@@ -109,27 +109,35 @@ unPreciseDuration = case _ of
 
 -- Conversions
 toNanoseconds :: PreciseDuration -> PreciseDuration
-toNanoseconds = Nanoseconds <<< unPreciseDuration
+toNanoseconds ns@(Nanoseconds _) = ns
+toNanoseconds duration = Nanoseconds (unPreciseDuration duration)
 
 toMicroseconds :: PreciseDuration -> PreciseDuration
+toMicroseconds us@(Microseconds _) = us
 toMicroseconds duration = Microseconds $ (Decimal.truncated (unPreciseDuration duration)) / micro
 
 toMilliseconds :: PreciseDuration -> PreciseDuration
+toMilliseconds ms@(Milliseconds _) = ms
 toMilliseconds duration = Milliseconds $ (Decimal.truncated (unPreciseDuration duration)) / milli
 
 toSeconds :: PreciseDuration -> PreciseDuration
+toSeconds s@(Seconds _) = s
 toSeconds duration = Seconds $ (Decimal.truncated (unPreciseDuration duration)) / second
 
 toMinutes :: PreciseDuration -> PreciseDuration
+toMinutes mins@(Minutes _) = mins
 toMinutes duration = Minutes $ (Decimal.truncated (unPreciseDuration duration)) / minute
 
 toHours :: PreciseDuration -> PreciseDuration
+toHours hours@(Hours _) = hours
 toHours duration = Hours $ (Decimal.truncated (unPreciseDuration duration)) / hour
 
 toDays :: PreciseDuration -> PreciseDuration
+toDays days@(Days _) = days
 toDays duration = Days $ (Decimal.truncated (unPreciseDuration duration)) / day
 
 toWeeks :: PreciseDuration -> PreciseDuration
+toWeeks weeks@(Weeks _) = weeks
 toWeeks duration = Weeks $ (Decimal.truncated (unPreciseDuration duration)) / week
 
 toDecimalLossy :: PreciseDuration -> Decimal

test/Data/PreciseDateTime/Locale.purs

@@ -2,53 +2,101 @@ module Test.Data.PreciseDateTime.Locale.Spec where
 
 import Prelude
 
-import Data.Decimal (fromInt)
+import Data.Decimal (Decimal)
+import Data.Decimal as Decimal
+import Data.Date as Date
 import Data.DateTime.Locale (LocalValue(..), Locale(..))
-import Data.Int (toNumber)
-import Data.Maybe (Maybe(..))
+import Data.Int (toNumber, floor)
+import Data.Maybe (Maybe(..), fromJust)
 import Data.PreciseDateTime (PreciseDateTime)
 import Data.PreciseDateTime as PDT
-import Data.PreciseDateTime.Locale (fromRFC3339String, toRFC3339String)
+import Data.PreciseDateTime.Locale (fromRFC3339String, toRFC3339String, diff)
 import Data.RFC3339String (RFC3339String(..))
 import Data.Time.Duration as Dur
 import Data.Time.PreciseDuration as PD
-import Test.Data.PreciseDateTime.Spec (dateStringFixture, preciseDateTimeFixture)
+import Partial.Unsafe (unsafePartial)
+import Test.Data.PreciseDateTime.Spec (dateStringFixture, preciseDateTimeFixture, mkPreciseDateTime)
 import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 
-withTZ :: Int -> PreciseDateTime -> Maybe (LocalValue PreciseDateTime)
-withTZ hrsTZ = map (LocalValue (Locale Nothing (Dur.convertDuration (Dur.Hours (toNumber hrsTZ)))))
-               <<< PDT.adjust (PD.hours (fromInt (negate hrsTZ)))
-withTZMins :: Int -> PreciseDateTime -> Maybe (LocalValue PreciseDateTime)
-withTZMins minsTZ = map (LocalValue (Locale Nothing (Dur.convertDuration (Dur.Minutes (toNumber minsTZ)))))
-               <<< PDT.adjust (PD.minutes (fromInt (negate minsTZ)))
+withTZ :: Int -> PreciseDateTime -> LocalValue PreciseDateTime
+withTZ hrsTZ = LocalValue (Locale Nothing (Dur.convertDuration (Dur.Hours (toNumber hrsTZ))))
+
+withTZMins :: Int -> PreciseDateTime -> LocalValue PreciseDateTime
+withTZMins = withTZMinsNum <<< toNumber
+
+withTZMinsNum :: Number -> PreciseDateTime -> LocalValue PreciseDateTime
+withTZMinsNum minsTZ = LocalValue (Locale Nothing (Dur.convertDuration (Dur.Minutes minsTZ)))
+
+unsafeFromString :: String -> Decimal
+unsafeFromString s = unsafePartial $ fromJust (Decimal.fromString s)
+
+minsToNs :: Int -> Decimal
+minsToNs m = Decimal.fromInt m * unsafeFromString "6E10"
 
 spec :: forall r. Spec r Unit
 spec =
   describe "LocalPreciseDateTime" do
     it "fromRFC3339String" do
 
       fromRFC3339String (RFC3339String $ dateStringFixture <> "+08:00")
-        `shouldEqual` withTZ 8 (preciseDateTimeFixture 0 0)
+        `shouldEqual` Just (withTZ 8 (preciseDateTimeFixture 0 0))
 
       fromRFC3339String (RFC3339String $ dateStringFixture <> "-08:00")
-        `shouldEqual` withTZ (-8) (preciseDateTimeFixture 0 0)
+        `shouldEqual` Just (withTZ (-8) (preciseDateTimeFixture 0 0))
 
       fromRFC3339String (RFC3339String $ dateStringFixture <> "Z")
-        `shouldEqual` withTZ 0 (preciseDateTimeFixture 0 0)
+        `shouldEqual` Just (withTZ 0 (preciseDateTimeFixture 0 0))
 
       fromRFC3339String (RFC3339String $ dateStringFixture <> "-00:00")
-        `shouldEqual` withTZ 0 (preciseDateTimeFixture 0 0)
+        `shouldEqual` Just (withTZ 0 (preciseDateTimeFixture 0 0))
 
       fromRFC3339String (RFC3339String $ dateStringFixture <> "+00:00")
-        `shouldEqual` withTZ 0 (preciseDateTimeFixture 0 0)
+        `shouldEqual` Just (withTZ 0 (preciseDateTimeFixture 0 0))
 
       fromRFC3339String (RFC3339String $ dateStringFixture <> "-00:01")
-        `shouldEqual` withTZMins (-1) (preciseDateTimeFixture 0 0)
+        `shouldEqual` Just (withTZMins (-1) (preciseDateTimeFixture 0 0))
 
     it "toRFC3339String" do
       toRFC3339String (LocalValue (Locale Nothing zero) (preciseDateTimeFixture 0 0))
         `shouldEqual` RFC3339String (dateStringFixture <>".0Z")
 
       toRFC3339String (LocalValue (Locale Nothing (Dur.convertDuration (Dur.Hours 4.0))) (preciseDateTimeFixture 0 0))
-        `shouldEqual` RFC3339String (dateStringFixture <>".0+04:00")
+        `shouldEqual` RFC3339String (dateStringFixture <> ".0+04:00")
+
+    it "Round Trip RFC3339String" do
+      let roundtrip rfcStr = let go = map toRFC3339String <<< fromRFC3339String
+                             in (Just rfcStr) `shouldEqual` go rfcStr
+
+      -- These tests are a bit finnicky because of how we normalise the RFC3339 representation,
+      -- eg. an input offset of '+00:00' gets printed as 'Z'
+      roundtrip (RFC3339String $ dateStringFixture <> ".0+08:00")
+
+      roundtrip (RFC3339String $ dateStringFixture <> ".0-08:00")
+
+      roundtrip (RFC3339String $ dateStringFixture <> ".0Z")
+
+      roundtrip (RFC3339String $ dateStringFixture <> ".0-00:01")
+
+    -- The diff machinery is tested in the 'PreciseDateTime' suite, here we only
+    -- test locale diffing.
+    it "diff" do
+      diff (withTZMins 0 (mkPreciseDateTime 1985 Date.March 13 0 0 0 0 0))
+           (withTZMins 0 (mkPreciseDateTime 1985 Date.March 13 0 0 0 0 0))
+        `shouldEqual` (PD.unsafeNanoseconds zero)
+
+      diff (withTZMins 100 (mkPreciseDateTime 1985 Date.March 13 0 0 0 0 0))
+           (withTZMins 100 (mkPreciseDateTime 1985 Date.March 13 0 0 0 0 0))
+        `shouldEqual` (PD.unsafeNanoseconds zero)
+
+      diff (withTZMins 100 (mkPreciseDateTime 1985 Date.March 13 0 0 0 0 0))
+           (withTZMins (-100) (mkPreciseDateTime 1985 Date.March 13 0 0 0 0 0))
+        `shouldEqual` (PD.unsafeNanoseconds (minsToNs 200))
+
+      diff (withTZMinsNum 0.01 (mkPreciseDateTime 1985 Date.March 13 0 0 0 0 0))
+           (withTZMins 0 (mkPreciseDateTime 1985 Date.March 12 23 59 59 999 999999))
+        `shouldEqual` (PD.unsafeNanoseconds (Decimal.fromInt 1 + unsafeFromString "6E8"))
+
+      diff (withTZMins 456 (mkPreciseDateTime 1985 Date.March 13 0 0 0 0 0))
+           (withTZMins 123 (mkPreciseDateTime 1985 Date.March 12 23 59 58 999 999999))
+        `shouldEqual` (PD.unsafeNanoseconds (Decimal.fromInt 1000000001 + minsToNs (456 - 123)))