Merge branch 'fix-forecast-date'

src/Types.hs

@@ -102,7 +102,7 @@ buildForecast location updated items@(firstItem:_) = do
     astart <- liftM (flip addHours firstTime) (firstAlertTime levels)
     aend <- liftM (flip addHours firstTime) (lastAlertTime levels)
     return Forecast { _fcLocation = location
-                    , _fcDate = utctDay astart
+                    , _fcDate = (localDay . utcToLocalTime' tz) astart
                     , _fcAlertStart = localDayTime astart
                     , _fcAlertEnd = localDayTime aend
                     , _fcMaxLevel = maxlevel

test/Spec.hs

@@ -5,6 +5,7 @@ import qualified TestFetcher
 import qualified TestFetcherArpansa
 import qualified TestFetcherEPA
 import qualified TestFetcherJMA
+import qualified TestTypes
 import qualified TestUtils
 import qualified Integration.TestLocations
 
@@ -16,5 +17,6 @@ spec = do
     describe "TestFetcherArpansa" TestFetcherArpansa.spec
     describe "TestFetcherEPA" TestFetcherEPA.spec
     describe "TestFetcherJMA" TestFetcherJMA.spec
+    describe "TestTypes" TestTypes.spec
     describe "TestUtils" TestUtils.spec
     describe "Integration.TestLocations" Integration.TestLocations.spec

test/TestFetcherJMA.hs

@@ -47,9 +47,11 @@ spec = do
             it "returns the last evening image name" $ do
                 imageNameTime (testTime 03 11) 01 `shouldBe`
                     (expected "201605191800-01", testTime 07 00)
+        context "during the day" $ do
             it "returns the morning image name" $ do
                 imageNameTime (testTime 08 25) 02 `shouldBe`
                     (expected "201605200600-02", testTime 08 00)
+        context "in the evening" $ do
             it "returns the evening image name" $ do
                 imageNameTime (testTime 19 31) 03 `shouldBe`
                     (expected "201605201800-03", testTimeTomorrow 09 00)

test/TestTypes.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+module TestTypes where
+
+{- Test Types module -}
+
+import Control.Lens
+
+import Data.Maybe
+import Data.Time
+import Data.Time.LocalTime.TimeZone.Series
+
+import Types
+import Types.Location
+import Types.Location.Japan
+
+import Test.Hspec
+
+
+japanTime :: Day -> Int -> Int -> UTCTime
+japanTime date hour minute = localTimeToUTC' japanTZ $ LocalTime date $ TimeOfDay hour minute 0
+
+
+spec :: Spec
+spec = do
+    describe "buildForecast" $ do
+        context "builds the forecast for the right time zone" $ do
+            let Just date = fromGregorianValid 2016 09 01
+            let atHour h = japanTime date h 0
+            let tokyo = Location "Japan" "Tokyo" "Tokyo"
+            it "is Nothing when there is no alert" $
+                buildForecast tokyo (atHour 19) [] `shouldBe` Nothing
+            it "has correct date and times when there is an alert" $ do
+                let levels = [ (atHour 6, UVLevel 1)
+                             , (atHour 7, UVLevel 2)
+                             , (atHour 8, UVLevel 3)
+                             , (atHour 9, UVLevel 4)
+                             , (atHour 10, UVLevel 5)
+                             , (atHour 11, UVLevel 4)
+                             , (atHour 12, UVLevel 3)
+                             , (atHour 13, UVLevel 2)
+                             , (atHour 14, UVLevel 1)
+                             ]
+                let Just forecast = buildForecast tokyo (atHour 19) levels
+                (forecast ^. fcDate) `shouldBe` (fromJust $ fromGregorianValid 2016 09 01)

uv-alert-server.cabal

@@ -110,6 +110,7 @@ test-suite uv-alert-server-test
                      , TestFetcherArpansa
                      , TestFetcherEPA
                      , TestFetcherJMA
+                     , TestTypes
                      , TestUtils
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010