From afa5e5ff0d119ddbcde8a0a627ee3de1049e6969 Mon Sep 17 00:00:00 2001 From: Lucas David Traverso Date: Sun, 28 Feb 2021 20:16:33 -0300 Subject: [PATCH] WIP --- packages/conferer/conferer.cabal | 5 +- packages/conferer/package.yaml | 1 + .../src/Conferer/FromConfig/Internal.hs | 61 ++++++++++++++++++- .../test/Conferer/FromConfig/TimeSpec.hs | 46 ++++++++++++++ 4 files changed, 111 insertions(+), 2 deletions(-) create mode 100644 packages/conferer/test/Conferer/FromConfig/TimeSpec.hs diff --git a/packages/conferer/conferer.cabal b/packages/conferer/conferer.cabal index 4f7f973..8d33b9a 100644 --- a/packages/conferer/conferer.cabal +++ b/packages/conferer/conferer.cabal @@ -4,7 +4,7 @@ cabal-version: 1.18 -- -- see: https://github.com/sol/hpack -- --- hash: e95018cf9b8ebe424a2926412853affcae168760a3b9ea0530fbf3a4c1d83b14 +-- hash: 786dba20a9ab2782cc8ca0d70b30fe8b384aff3f45f378ac4ce2fe78537e82bd name: conferer version: 1.0.0.1 @@ -57,6 +57,7 @@ library , directory >=1.2 && <2.0 , filepath >=1.0 && <2.0 , text >=1.1 && <1.3 + , time if impl(ghc >= 8.4.1) ghc-options: -Wpartial-fields default-language: Haskell2010 @@ -73,6 +74,7 @@ test-suite specs Conferer.FromConfig.MaybeSpec Conferer.FromConfig.NumbersSpec Conferer.FromConfig.StringLikeSpec + Conferer.FromConfig.TimeSpec Conferer.FromConfigSpec Conferer.GenericsSpec Conferer.KeySpec @@ -100,6 +102,7 @@ test-suite specs , filepath >=1.0 && <2.0 , hspec , text >=1.1 && <1.3 + , time if impl(ghc >= 8.4.1) ghc-options: -Wpartial-fields default-language: Haskell2010 diff --git a/packages/conferer/package.yaml b/packages/conferer/package.yaml index 401f1b9..3c4e137 100644 --- a/packages/conferer/package.yaml +++ b/packages/conferer/package.yaml @@ -16,6 +16,7 @@ dependencies: - text >= 1.1 && < 1.3 - directory >= 1.2 && < 2.0 - filepath >= 1.0 && < 2.0 + - time tests: specs: diff --git a/packages/conferer/src/Conferer/FromConfig/Internal.hs b/packages/conferer/src/Conferer/FromConfig/Internal.hs index d17a4a6..d2ed304 100644 --- a/packages/conferer/src/Conferer/FromConfig/Internal.hs +++ b/packages/conferer/src/Conferer/FromConfig/Internal.hs @@ -26,7 +26,10 @@ import Data.Typeable import Text.Read (readMaybe) import Data.Dynamic import GHC.Generics -import Data.Function ((&)) +import Data.Function (on, (&)) +import qualified Data.Time as Time +import qualified Data.Time.Format.ISO8601 as Time +import qualified Data.Time.Clock as Time import Conferer.Key import Conferer.Config.Internal.Types @@ -215,6 +218,58 @@ instance FromConfig File where applyIfPresent f maybeComponent = (\fp -> maybe fp (f fp) maybeComponent) +instance FromConfig Time.DayOfWeek where + fromConfig = + fetchFromConfigWith $ + (\case + "sunday" -> Just Time.Sunday + "sun" -> Just Time.Sunday + + "monday" -> Just Time.Monday + "mon" -> Just Time.Monday + + "tuesday" -> Just Time.Tuesday + "tue" -> Just Time.Tuesday + + "wednesday" -> Just Time.Wednesday + "wed" -> Just Time.Wednesday + + "thursday" -> Just Time.Thursday + "thu" -> Just Time.Thursday + + "friday" -> Just Time.Friday + "fri" -> Just Time.Friday + + "saturday" -> Just Time.Saturday + "sat" -> Just Time.Saturday + + _ -> Nothing + ) . Text.toLower + +instance FromConfig Time.Day where + fromConfig = fetchFromConfigByIso8601 + +instance FromConfig Time.TimeOfDay where + fromConfig = fetchFromConfigByIso8601 + +instance FromConfig Time.UTCTime where + fromConfig = fetchFromConfigByIso8601 + +instance FromConfig Time.LocalTime where + fromConfig = fetchFromConfigByIso8601 + +instance FromConfig Time.TimeZone where + fromConfig = fetchFromConfigByIso8601 + +instance FromConfig Time.ZonedTime where + fromConfig = fetchFromConfigByIso8601 + +instance FromConfig Time.CalendarDiffDays where + fromConfig = fetchFromConfigByIso8601 + +instance FromConfig Time.CalendarDiffTime where + fromConfig = fetchFromConfigByIso8601 + -- | Helper function to parse a 'Bool' from 'Text' parseBool :: Text -> Maybe Bool parseBool text = @@ -235,6 +290,10 @@ data OverrideFromConfig a = fetchFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> IO a fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack) +-- | Helper function to implement fetchFromConfig using the 'Time.ISO8601' instance +fetchFromConfigByIso8601 :: (Typeable a, Time.ISO8601 a) => Key -> Config -> IO a +fetchFromConfigByIso8601 = fetchFromConfigWith (Time.iso8601ParseM . Text.unpack) + -- | Helper function to implement fetchFromConfig using the 'IsString' instance fetchFromConfigByIsString :: (Typeable a, IsString a) => Key -> Config -> IO a fetchFromConfigByIsString = fetchFromConfigWith (Just . fromString . Text.unpack) diff --git a/packages/conferer/test/Conferer/FromConfig/TimeSpec.hs b/packages/conferer/test/Conferer/FromConfig/TimeSpec.hs new file mode 100644 index 0000000..604f205 --- /dev/null +++ b/packages/conferer/test/Conferer/FromConfig/TimeSpec.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE TypeApplications #-} + +module Conferer.FromConfig.TimeSpec (spec) where + +import Test.Hspec +import Conferer.FromConfig.Extended +import Data.Time +import Data.Time.Calendar.OrdinalDate (fromOrdinalDate) +import Data.Time.Calendar.WeekDate +import Data.Maybe + +spec :: Spec +spec = do + fcontext "Basic fetching" $ do + describe "fetching a Day from config" $ do + let + februay3th2021 = fromOrdinalDate 2021 3 + ensureEmptyConfigThrows @Day + ensureUsingDefaultReturnsSameValue @Day februay3th2021 + ensureSingleConfigParsesTheRightThing @Day "2021-01-03" februay3th2021 + ensureSingleConfigParsesTheRightThing @Day "0000-01-03" $ fromOrdinalDate 0 3 + describe "with missing leading zeros" $ do + ensureSingleConfigThrowsParserError @Day "2021-1-3" + ensureSingleConfigThrowsParserError @Day "2021-1-03" + ensureSingleConfigThrowsParserError @Day "2021-01-3" + + describe "fetching a DayOfWeek" $ do + ensureEmptyConfigThrows @DayOfWeek + ensureUsingDefaultReturnsSameValue @DayOfWeek Monday + ensureSingleConfigParsesTheRightThing @DayOfWeek "Monday" Monday + context "with a lower case day" $ do + ensureSingleConfigParsesTheRightThing @DayOfWeek "monday" Monday + context "with a three letter abreviation" $ do + ensureSingleConfigParsesTheRightThing @DayOfWeek "mon" Monday + + describe "fetching a TimeOfDay from config" $ do + ensureEmptyConfigThrows @TimeOfDay + ensureUsingDefaultReturnsSameValue @TimeOfDay midnight + ensureSingleConfigParsesTheRightThing @TimeOfDay "00:30:00" $ fromJust $ makeTimeOfDayValid 0 30 0 + ensureSingleConfigParsesTheRightThing @TimeOfDay "00:30:00.5" $ fromJust $ makeTimeOfDayValid 0 30 0.5 + ensureSingleConfigParsesTheRightThing @TimeOfDay "00:00:00" $ midnight + + describe "with values that overflow" $ do + ensureSingleConfigThrowsParserError @TimeOfDay "70:00:00" + ensureSingleConfigThrowsParserError @TimeOfDay "00:70:00" + ensureSingleConfigThrowsParserError @TimeOfDay "00:00:70"