thyme-0.4.1: tests/Common.hs

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Common where

#if HLINT
#include "cabal_macros.h"
#endif

import Prelude
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Lens
import Data.AdditiveGroup
import Data.Char
import Data.Thyme
import Data.Thyme.Clock.POSIX
import System.Exit
import Test.QuickCheck
import qualified Test.QuickCheck.Gen as Gen

exit :: Bool -> IO ()
exit b = exitWith $ if b then ExitSuccess else ExitFailure 1

------------------------------------------------------------------------

-- FIXME: We disagree with time on how many digits to use for year.
newtype RecentTime = RecentTime UTCTime deriving (Show)

instance Arbitrary RecentTime where
    arbitrary = fmap (RecentTime . review utcTime) $ UTCView
            <$> choose (minDay, maxDay)
            <*> choose (zeroV, pred dayLength) where
        minDay = gregorian # YearMonthDay 1000 1 1
        maxDay = gregorian # YearMonthDay 9999 12 13
        dayLength = posixDayLength ^. microseconds . from microseconds

------------------------------------------------------------------------

newtype Spec = Spec String deriving (Show)

instance Arbitrary Spec where
    arbitrary = do
        -- Pick a non-overlapping day spec generator.
        day <- Gen.elements
            [ spec {-YearMonthDay-}"DFYyCBbhmde"
            , spec {-OrdinalDate-}"YyCj"
            -- TODO: time only consider the presence of %V as
            -- indication that it should parse as WeekDate
            , (++) "%V " <$> spec {-WeekDate-}"GgfuwAa"
            , spec {-SundayWeek-}"YyCUuwAa"
            , spec {-MondayWeek-}"YyCWuwAa"
            ] :: Gen (Gen String)
        -- Pick a non-overlapping day & tod spec generator.
        time <- Gen.frequency
            [ (16, pure $ Gen.frequency
                [ (8, day)
                , (4, rod)
                , (2, h12)
                , (1, sec)
                , (1, spec {-TimeZone-}"zZ")
                ] )
            -- TODO: these are broken due to issues above and below
            -- , (2, pure $ spec {-aggregate-}"crXx")
            , (1, pure $ spec {-UTCTime-}"s")
            ] :: Gen (Gen String)
        fmap (Spec . dropWhile isSpace . unwords) . listOf1 $ frequency
            [(16, time), (4, string), (1, pure "%%")]
      where
        spec = Gen.elements . fmap (\ c -> ['%', c])
        string = filter ('%' /=) <$> arbitrary
        -- TODO: time discards %q %Q or %p %P after setting %S or hours
        -- respectively. Fudge it by always including %q and %p at end.
        -- tod = spec {-TimeOfDay-}"RTPpHIklMSqQ"
        rod = spec {-RestOfDay-}"RHkMqQ"
        sec = (++ " %q") <$> spec {-seconds-}"ST"
        h12 = (++ " %p") <$> spec {-12-hour-}"Il"