diff --git a/README.md b/README.md index 8735777..e278816 100644 --- a/README.md +++ b/README.md @@ -22,23 +22,23 @@ Formatter has following properties Number will be padded with zeros to have at least this number of leading zeros. This doesn't restrict number to have more digits then leading zeros in format string. -+ `0000.0` will show 4 digits: `12 -> "0012.0"`, `1234 -> "1234.0"` -+ `00.0` will show only 2 digits : `12 -> "12.0"`, `1234 -> "1234.0"` ++ `0000.0` will show 4 digits: `12 → "0012.0"`, `1234 → "1234.0"` ++ `00.0` will show only 2 digits : `12 → "12.0"`, `1234 → "1234.0"` Number of digits after dot is set by number of trailing zeros (note the rounding) -+ `0.000` will show 3 digits: `0.12345 -> "0.123"`, `12.98765 -> "12.988"` -+ `0.0` will show only 1 digit: `0.12345 -> "0.1"`, `12.98765 -> "13.0"` ++ `0.000` will show 3 digits: `0.12345 → "0.123"`, `12.98765 → "12.988"` ++ `0.0` will show only 1 digit: `0.12345 → "0.1"`, `12.98765 → "13.0"` If number is lesser then zero `-` is always printed. Otherwise you could specify `+` in format string -+ `+0`: `12.0 -> "+12"`, `-34.8 -> "-35"` -+ `0`: `12.0 -> "12"`, `-34.8 -> "-35"` ++ `+0`: `12.0 → "+12"`, `-34.8 → "-35"` ++ `0`: `12.0 → "12"`, `-34.8 → "-35"` Thousands separator is specified as `,0` please note that this `0` isn't counted as leading. -+ `00,0`: `1234567890 -> "1,234,567,890.0", `1 -> "1.0"` ++ `00,0`: `1234567890 → "1,234,567,890.0", `1 → "1.0"` For abbreviation one could use `a` flag. In general it tries to find the closest power of thousand and then use formatter to result of division of input number and that power. -+ `0a`: `1234567 -> "1M"`, `1 -> "1"` ++ `0a`: `1234567 → "1M"`, `1 → "1"` ## Date/Time formatters diff --git a/bower.json b/bower.json index 8206534..04a3a74 100644 --- a/bower.json +++ b/bower.json @@ -17,14 +17,20 @@ ], "dependencies": { "purescript-prelude": "^3.0.0", - "purescript-parsing": "^4.0.0", + "purescript-parsing": "^4.2.1", "purescript-fixed-points": "^4.0.0", - "purescript-datetime": "^3.0.0" + "purescript-datetime": "^v3.3.0", + "purescript-transformers": "^3.4.0", + "purescript-lists": "^4.3.0", + "purescript-generics-rep": "^5.0.0" }, "devDependencies": { "purescript-aff": "^3.0.0", "purescript-console": "^3.0.0", "purescript-psci-support": "^3.0.0", - "purescript-debug": "^3.0.0" + "purescript-spec": "^0.14.0" + }, + "resolutions": { + "purescript-datetime": "interval" } } diff --git a/src/Data/Formatter/DateTime.purs b/src/Data/Formatter/DateTime.purs index f369ef5..39fd492 100644 --- a/src/Data/Formatter/DateTime.purs +++ b/src/Data/Formatter/DateTime.purs @@ -1,267 +1,203 @@ module Data.Formatter.DateTime ( Formatter - , FormatterF(..) + , FormatterCommand(..) + , Meridiem , printFormatter + , printFormatterCommand , parseFormatString , format , formatDateTime , unformat , unformatDateTime + , unformatParser ) where import Prelude -import Control.Lazy as Lazy -import Control.Monad.State (State, runState, put, modify) +import Control.Alt ((<|>)) +import Control.Alternative (class Alternative) +import Control.Apply (lift2) +import Control.Lazy as Z +import Control.Monad.Reader.Trans (ReaderT, runReaderT, ask) +import Control.Monad.State (State, modify, put, runState) import Control.Monad.Trans.Class (lift) - -import Data.Ord (abs) -import Data.Array (some) -import Data.Array as Arr -import Data.Bifunctor (lmap) +import Data.Array as Array import Data.Date as D import Data.DateTime as DT import Data.DateTime.Instant (instant, toDateTime, fromDateTime, unInstant) -import Data.Either (Either(..)) +import Data.Either (Either(..), either) import Data.Enum (fromEnum, toEnum) -import Data.Functor.Mu (Mu, unroll, roll) +import Data.Foldable (foldMap) +import Data.Formatter.Internal (foldDigits) +import Data.Formatter.Parser.Number (parseDigit) +import Data.Formatter.Parser.Utils (runP, oneOfAs) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) import Data.Int as Int -import Data.Maybe (Maybe(..), maybe, isJust, fromMaybe) +import Data.List as List +import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Newtype (unwrap) +import Data.Ord (abs) import Data.String as Str import Data.Time as T import Data.Time.Duration as Dur import Data.Tuple (Tuple(..)) -import Data.Formatter.Internal (digit, foldDigits) - import Text.Parsing.Parser as P import Text.Parsing.Parser.Combinators as PC import Text.Parsing.Parser.String as PS - -data FormatterF a - = YearFull a - | YearTwoDigits a - | YearAbsolute a - | MonthFull a - | MonthShort a - | MonthTwoDigits a - | DayOfMonthTwoDigits a - | DayOfMonth a - | UnixTimestamp a - | DayOfWeek a - | Hours24 a - | Hours12 a - | Meridiem a - | Minutes a - | MinutesTwoDigits a - | Seconds a - | SecondsTwoDigits a - | Milliseconds a - | MillisecondsShort a - | MillisecondsTwoDigits a - | Placeholder String a - | End - -instance formatterFFunctor ∷ Functor FormatterF where - map f (YearFull a) = YearFull $ f a - map f (YearTwoDigits a) = YearTwoDigits $ f a - map f (YearAbsolute a) = YearAbsolute $ f a - map f (MonthFull a) = MonthFull $ f a - map f (MonthShort a) = MonthShort $ f a - map f (MonthTwoDigits a) = MonthTwoDigits $ f a - map f (DayOfMonthTwoDigits a) = DayOfMonthTwoDigits $ f a - map f (DayOfMonth a) = DayOfMonth $ f a - map f (UnixTimestamp a) = UnixTimestamp $ f a - map f (DayOfWeek a) = DayOfWeek $ f a - map f (Hours24 a) = Hours24 $ f a - map f (Hours12 a) = Hours12 $ f a - map f (Meridiem a) = Meridiem $ f a - map f (Minutes a) = Minutes $ f a - map f (MinutesTwoDigits a) = MinutesTwoDigits $ f a - map f (Seconds a) = Seconds $ f a - map f (SecondsTwoDigits a) = SecondsTwoDigits $ f a - map f (Milliseconds a) = Milliseconds $ f a - map f (MillisecondsShort a) = MillisecondsShort $ f a - map f (MillisecondsTwoDigits a) = MillisecondsTwoDigits $ f a - map f (Placeholder str a) = Placeholder str $ f a - map f End = End - -type Formatter = Mu FormatterF - -printFormatterF - ∷ ∀ a - . (a → String) - → FormatterF a - → String -printFormatterF cb = case _ of - YearFull a → "YYYY" <> cb a - YearTwoDigits a → "YY" <> cb a - YearAbsolute a → "Y" <> cb a - MonthFull a → "MMMM" <> cb a - MonthShort a → "MMM" <> cb a - MonthTwoDigits a → "MM" <> cb a - DayOfMonthTwoDigits a → "DD" <> cb a - DayOfMonth a → "D" <> cb a - UnixTimestamp a → "X" <> cb a - DayOfWeek a → "E" <> cb a - Hours24 a → "HH" <> cb a - Hours12 a → "hh" <> cb a - Meridiem a → "a" <> cb a - Minutes a → "m" <> cb a - MinutesTwoDigits a → "mm" <> cb a - Seconds a → "s" <> cb a - SecondsTwoDigits a → "ss" <> cb a - MillisecondsShort a → "S" <> cb a - MillisecondsTwoDigits a → "SS" <> cb a - Milliseconds a → "SSS" <> cb a - Placeholder s a → s <> cb a - End → "" +data FormatterCommand + = YearFull + | YearTwoDigits + | YearAbsolute + | MonthFull + | MonthShort + | MonthTwoDigits + | DayOfMonthTwoDigits + | DayOfMonth + | UnixTimestamp + | DayOfWeek + | Hours24 + | Hours12 + | Meridiem + | Minutes + | MinutesTwoDigits + | Seconds + | SecondsTwoDigits + | Milliseconds + | MillisecondsShort + | MillisecondsTwoDigits + | Placeholder String + +derive instance eqFormatterCommand ∷ Eq (FormatterCommand) +derive instance genericFormatter ∷ Generic FormatterCommand _ +instance showFormatter ∷ Show FormatterCommand where + show = genericShow + +type Formatter = List.List FormatterCommand + +printFormatterCommand ∷ FormatterCommand → String +printFormatterCommand = case _ of + YearFull → "YYYY" + YearTwoDigits → "YY" + YearAbsolute → "Y" + MonthFull → "MMMM" + MonthShort → "MMM" + MonthTwoDigits → "MM" + DayOfMonthTwoDigits → "DD" + DayOfMonth → "D" + UnixTimestamp → "X" + DayOfWeek → "E" + Hours24 → "HH" + Hours12 → "hh" + Meridiem → "a" + Minutes → "m" + MinutesTwoDigits → "mm" + Seconds → "s" + SecondsTwoDigits → "ss" + MillisecondsShort → "S" + MillisecondsTwoDigits → "SS" + Milliseconds → "SSS" + Placeholder s → s printFormatter ∷ Formatter → String -printFormatter f = printFormatterF printFormatter $ unroll f +printFormatter = foldMap printFormatterCommand parseFormatString ∷ String → Either String Formatter -parseFormatString s = - lmap P.parseErrorMessage $ P.runParser s formatParser +parseFormatString = runP formatParser + +placeholderContent ∷ P.Parser String String +placeholderContent = + Str.toCharArray "YMDEHhamsS" + # PS.noneOf + # Array.some + <#> Str.fromCharArray + +formatterCommandParser ∷ P.Parser String FormatterCommand +formatterCommandParser = (PC.try <<< PS.string) `oneOfAs` + [ Tuple "YYYY" YearFull + , Tuple "YY" YearTwoDigits + , Tuple "Y" YearAbsolute + , Tuple "MMMM" MonthFull + , Tuple "MMM" MonthShort + , Tuple "MM" MonthTwoDigits + , Tuple "DD" DayOfMonthTwoDigits + , Tuple "D" DayOfMonth + , Tuple "E" DayOfWeek + , Tuple "HH" Hours24 + , Tuple "hh" Hours12 + , Tuple "a" Meridiem + , Tuple "mm" MinutesTwoDigits + , Tuple "m" Minutes + , Tuple "ss" SecondsTwoDigits + , Tuple "s" Seconds + , Tuple "SSS" Milliseconds + , Tuple "SS" MillisecondsTwoDigits + , Tuple "S" MillisecondsShort + ] <|> (Placeholder <$> placeholderContent) + +formatParser ∷ P.Parser String Formatter +formatParser = List.some formatterCommandParser -- | Formatting function that accepts a number that is a year, -- | and strips away the non-significant digits, leaving only the -- | ones and tens positions. -formatYearTwoDigits :: Int -> String +formatYearTwoDigits ∷ Int → String formatYearTwoDigits i = case dateLength of - 1 -> "0" <> dateString - 2 -> dateString - _ -> Str.drop (dateLength - 2) dateString + 1 → "0" <> dateString + 2 → dateString + _ → Str.drop (dateLength - 2) dateString where - dateString = show $ abs i - dateLength = Str.length $ dateString - - -placeholderContent ∷ P.Parser String String -placeholderContent = - map Str.fromCharArray - $ PC.try - $ Arr.some - $ PS.noneOf - $ Str.toCharArray "YQMDXWEHhamsS" - -formatterFParser - ∷ ∀ a - . P.Parser String a - → P.Parser String (FormatterF a) -formatterFParser cb = - PC.choice - [ (PC.try $ PS.string "YYYY") *> map YearFull cb - , (PC.try $ PS.string "YY") *> map YearTwoDigits cb - , (PC.try $ PS.string "Y") *> map YearAbsolute cb - , (PC.try $ PS.string "MMMM") *> map MonthFull cb - , (PC.try $ PS.string "MMM") *> map MonthShort cb - , (PC.try $ PS.string "MM") *> map MonthTwoDigits cb - , (PC.try $ PS.string "DD") *> map DayOfMonthTwoDigits cb - , (PC.try $ PS.string "D") *> map DayOfMonth cb - , (PC.try $ PS.string "E") *> map DayOfWeek cb - , (PC.try $ PS.string "HH") *> map Hours24 cb - , (PC.try $ PS.string "hh") *> map Hours12 cb - , (PC.try $ PS.string "a") *> map Meridiem cb - , (PC.try $ PS.string "mm") *> map MinutesTwoDigits cb - , (PC.try $ PS.string "m") *> map Minutes cb - , (PC.try $ PS.string "ss") *> map SecondsTwoDigits cb - , (PC.try $ PS.string "s") *> map Seconds cb - , (PC.try $ PS.string "SSS") *> map Milliseconds cb - , (PC.try $ PS.string "SS") *> map MillisecondsTwoDigits cb - , (PC.try $ PS.string "S") *> map MillisecondsShort cb - , (Placeholder <$> placeholderContent <*> cb) - , (PS.eof $> End) - ] - -formatParser ∷ P.Parser String Formatter -formatParser = - Lazy.fix \f → map roll $ formatterFParser f - -formatF - ∷ ∀ a - . (a → String) - → DT.DateTime - → FormatterF a - → String -formatF cb dt@(DT.DateTime d t) = case _ of - YearFull a → - (show $ fromEnum $ D.year d) <> cb a - YearTwoDigits a -> - let y = (fromEnum $ D.year d) - in (formatYearTwoDigits y) <> cb a - YearAbsolute a → - show (fromEnum $ D.year d) <> cb a - MonthFull a → - show (D.month d) <> cb a - MonthShort a → - printShortMonth (D.month d) <> cb a - MonthTwoDigits a → - let month = fromEnum $ D.month d - in (padSingleDigit month) <> cb a - DayOfMonthTwoDigits a → - (padSingleDigit $ fromEnum $ D.day d) <> cb a - DayOfMonth a → - show (fromEnum $ D.day d) <> cb a - UnixTimestamp a → - (show $ Int.floor $ (_ / 1000.0) $ unwrap $ unInstant $ fromDateTime dt) <> cb a - DayOfWeek a → - show (fromEnum $ D.weekday d) <> cb a - Hours24 a → - padSingleDigit (fromEnum $ T.hour t) <> cb a - Hours12 a → - let fix12 h = if h == 0 then 12 else h - in (padSingleDigit $ fix12 $ (fromEnum $ T.hour t) `mod` 12) <> cb a - Meridiem a → - (if (fromEnum $ T.hour t) >= 12 then "PM" else "AM") <> cb a - Minutes a → - show (fromEnum $ T.minute t) <> cb a - MinutesTwoDigits a → - (padSingleDigit <<< fromEnum $ T.minute t) <> cb a - Seconds a → - show (fromEnum $ T.second t) <> cb a - SecondsTwoDigits a → - (padSingleDigit <<< fromEnum $ T.second t) <> cb a - Milliseconds a → - (padDoubleDigit <<< fromEnum $ T.millisecond t) <> cb a - MillisecondsShort a → - (show $ (_ / 100) $ fromEnum $ T.millisecond t) <> cb a - MillisecondsTwoDigits a → - (padSingleDigit $ (_ / 10) $ fromEnum $ T.millisecond t) <> cb a - Placeholder s a → - s <> cb a - End → "" - -padSingleDigit :: Int -> String + dateString = show $ abs i + dateLength = Str.length $ dateString + +fix12 ∷ Int → Int +fix12 h = if h == 0 then 12 else h + +formatCommand ∷ DT.DateTime → FormatterCommand → String +formatCommand dt@(DT.DateTime d t) = case _ of + YearFull → show $ fromEnum $ D.year d + YearTwoDigits → formatYearTwoDigits $ fromEnum $ D.year d + YearAbsolute → show $ fromEnum $ D.year d + MonthFull → show $ D.month d + MonthShort → printShortMonth $ D.month d + MonthTwoDigits → padSingleDigit $ fromEnum $ D.month d + DayOfMonthTwoDigits → padSingleDigit $ fromEnum $ D.day d + DayOfMonth → show $ fromEnum $ D.day d + UnixTimestamp → show $ Int.floor $ (_ / 1000.0) $ unwrap $ unInstant $ fromDateTime dt + DayOfWeek → show $ fromEnum $ D.weekday d + Hours24 → padSingleDigit (fromEnum $ T.hour t) + Hours12 → padSingleDigit $ fix12 $ (fromEnum $ T.hour t) `mod` 12 + Meridiem → if (fromEnum $ T.hour t) >= 12 then "PM" else "AM" + Minutes → show $ fromEnum $ T.minute t + MinutesTwoDigits → padSingleDigit <<< fromEnum $ T.minute t + Seconds → show $ fromEnum $ T.second t + SecondsTwoDigits → padSingleDigit <<< fromEnum $ T.second t + Milliseconds → padDoubleDigit <<< fromEnum $ T.millisecond t + MillisecondsShort → show $ (_ / 100) $ fromEnum $ T.millisecond t + MillisecondsTwoDigits → padSingleDigit $ (_ / 10) $ fromEnum $ T.millisecond t + Placeholder s → s + +padSingleDigit ∷ Int → String padSingleDigit i | i < 10 = "0" <> (show i) | otherwise = show i -padDoubleDigit :: Int -> String +padDoubleDigit ∷ Int → String padDoubleDigit i - | i < 100 && i > 10 = "0" <> (show i) - | i < 100 && i < 10 = "00" <> (show i) + | i < 10 = "00" <> (show i) + | i < 100 = "0" <> (show i) | otherwise = show i format ∷ Formatter → DT.DateTime → String -format f dt = formatF (flip format dt) dt $ unroll f +format f d = foldMap (formatCommand d) f formatDateTime ∷ String → DT.DateTime → Either String String formatDateTime pattern datetime = - parseFormatString pattern <#> flip format datetime + parseFormatString pattern <#> (_ `format` datetime) unformat ∷ Formatter → String → Either String DT.DateTime -unformat f s = - let - run = - runState - (P.runParserT s $ unformatParser f) - initialAccum - in - case run of - Tuple (Left err) _ → Left $ P.parseErrorMessage err - Tuple _ accum → unformatAccumToDateTime accum +unformat = runP <<< unformatParser data Meridiem = AM | PM @@ -315,186 +251,167 @@ unformatAccumToDateTime a = | otherwise = Nothing -unformatFParser - ∷ ∀ a - . (a → P.ParserT String (State UnformatAccum) Unit) - → FormatterF a - → P.ParserT String (State UnformatAccum) Unit -unformatFParser cb = case _ of - YearFull a → do - ds ← some digit - when (Arr.length ds /= 4) $ P.fail "Incorrect full year" - lift $ modify _{year = Just $ foldDigits ds} - cb a - YearTwoDigits a → do - ds ← some digit - when (Arr.length ds /= 2) $ P.fail "Incorrect 2-digit year" - let y = foldDigits ds - lift $ modify _{year = Just $ if y > 69 then y + 1900 else y + 2000} - cb a - YearAbsolute a → do - sign ← PC.optionMaybe $ PC.try $ PS.string "-" - year ← map foldDigits $ some digit - lift $ modify _{year = Just $ (if isJust sign then -1 else 1) * year} - cb a - MonthFull a → do - month ← parseMonth - lift $ modify _{month = Just $ fromEnum month} - cb a - MonthShort a → do - month ← parseShortMonth - lift $ modify _{month = Just $ fromEnum month} - cb a - MonthTwoDigits a → do - ds ← some digit - let month = foldDigits ds - when (Arr.length ds /= 2 || month > 12 || month < 1) $ P.fail "Incorrect 2-digit month" - lift $ modify _{month = Just month} - cb a - DayOfMonthTwoDigits a → do - ds ← some digit - let dom = foldDigits ds - when (Arr.length ds /= 2 || dom > 31 || dom < 1) $ P.fail "Incorrect day of month" - lift $ modify _{day = Just dom} - cb a - DayOfMonth a → do - ds ← some digit - let dom = foldDigits ds - when (Arr.length ds > 2 || dom > 31 || dom < 1) $ P.fail "Incorrect day of month" - lift $ modify _{day = Just dom} - cb a - UnixTimestamp a → do - s ← map foldDigits $ some digit + +exactLength ∷ ∀ e. ReaderT { maxLength ∷ Int, length ∷ Int | e } (Either String) Unit +exactLength = ask >>= \({maxLength, length}) → lift if maxLength /= length + then Left $ "Expected " <> (show maxLength) <> " digits but got " <> (show length) + else Right unit + +validateRange ∷ ∀ e. Int → Int → ReaderT { num ∷ Int | e } (Either String) Unit +validateRange min max = ask >>= \({num}) → lift if num < min || num > max + then Left $ "Number is out of range [ " <> (show min) <> ", " <> (show max) <> " ]" + else Right unit + +-- NOTE related discussion: https://github.com/purescript-contrib/purescript-parsing/issues/57 +-- | Attempt a computation `n` times, requiring at least one success. +-- | +-- | The `Lazy` constraint is used to generate the result lazily, to ensure +-- | termination. +takeSome :: ∀ f a. Alternative f ⇒ Z.Lazy (f (List.List a)) ⇒ Int → f a → f (List.List a) +takeSome 0 _ = pure List.Nil +takeSome n v = List.Cons <$> v <*> Z.defer (\_ → takeMany (n - 1) v) + +-- | Attempt a computation `n` times, returning as many successful results +-- | as possible (possibly zero). +-- | +-- | The `Lazy` constraint is used to generate the result lazily, to ensure +-- | termination. +takeMany :: ∀ f a. Alternative f ⇒ Z.Lazy (f (List.List a)) ⇒ Int → f a → f (List.List a) +takeMany 0 _ = pure List.Nil +takeMany n v = takeSome n v <|> pure List.Nil + + +parseInt ∷ ∀ m + . Monad m + ⇒ Int + → ReaderT { length ∷ Int, num ∷ Int, maxLength ∷ Int } (Either String) Unit + → String + → P.ParserT String m Int +parseInt maxLength validators errMsg = do + ds ← takeSome maxLength parseDigit + let + length = List.length ds + num = foldDigits ds + case runReaderT validators {length, num, maxLength} of + Left err → P.fail $ errMsg <> "(" <> err <> ")" + Right _ → pure num + +unformatCommandParser ∷ FormatterCommand → P.ParserT String (State UnformatAccum) Unit +unformatCommandParser = case _ of + YearFull → _{year = _} `modifyWithParser` + (parseInt 4 exactLength "Incorrect full year") + YearTwoDigits → _{year = _} `modifyWithParser` + (parseInt 2 exactLength "Incorrect 2-digit year") + YearAbsolute → _{year = _} `modifyWithParser` + (lift2 (*) + (PC.option 1 $ PC.try $ PS.string "-" <#> (const (-1))) + (List.some parseDigit <#> foldDigits)) + MonthFull → _{month = _} `modifyWithParser` + (fromEnum <$> parseMonth) + MonthShort → _{month = _} `modifyWithParser` + (fromEnum <$> parseShortMonth) + MonthTwoDigits → _{month = _} `modifyWithParser` + (parseInt 2 (validateRange 1 12 <> exactLength) "Incorrect 2-digit month") + DayOfMonthTwoDigits → _{day = _} `modifyWithParser` + (parseInt 2 (validateRange 1 31 <> exactLength) "Incorrect day of month") + DayOfMonth → _{day = _} `modifyWithParser` + (parseInt 2 (validateRange 1 31) "Incorrect day of month") + UnixTimestamp → do + s ← map foldDigits $ List.some parseDigit case map toDateTime $ instant $ Dur.Milliseconds $ 1000.0 * Int.toNumber s of Nothing → P.fail "Incorrect timestamp" - Just (DT.DateTime d t) → do - lift $ put { year: Just $ fromEnum $ D.year d - , month: Just $ fromEnum $ D.month d - , day: Just $ fromEnum $ D.day d - , hour: Just $ fromEnum $ T.hour t - , minute: Just $ fromEnum $ T.minute t - , second: Just $ fromEnum $ T.second t - , millisecond: Just $ fromEnum $ T.millisecond t - , meridiem: (Nothing ∷ Maybe Meridiem) - } - cb a - DayOfWeek a → do - dow ← digit - when (dow > 7 || dow < 1) $ P.fail "Incorrect day of week" - cb a - Hours24 a → do - ds ← some digit - let hh = foldDigits ds - when (Arr.length ds /= 2 || hh < 0 || hh > 23) $ P.fail "Incorrect 24 hour" - lift $ modify _{hour = Just hh} - cb a - Hours12 a → do - ds ← some digit - let hh = foldDigits ds - when (Arr.length ds /= 2 || hh < 0 || hh > 11) $ P.fail "Incorrect 24 hour" - lift $ modify _{hour = Just hh} - cb a - Meridiem a → do - m ← - PC.choice [ PC.try $ PS.string "am" - , PC.try $ PS.string "AM" - , PC.try $ PS.string "pm" - , PC.try $ PS.string "PM" - ] - let f | m == "am" || m == "AM" = _{meridiem = Just AM} - | m == "pm" || m == "PM" = _{meridiem = Just PM} - | otherwise = id - lift $ modify f - cb a - MinutesTwoDigits a → do - ds ← some digit - let mm = foldDigits ds - when (Arr.length ds /= 2 || mm < 0 || mm > 59) $ P.fail "Incorrect 2-digit minute" - lift $ modify _{minute = Just mm} - cb a - Minutes a → do - ds ← some digit - let mm = foldDigits ds - when (Arr.length ds > 2 || mm < 0 || mm > 59) $ P.fail "Incorrect minute" - lift $ modify _{minute = Just mm} - cb a - SecondsTwoDigits a → do - ds ← some digit - let ss = foldDigits ds - when (Arr.length ds /= 2 || ss < 0 || ss > 59) $ P.fail "Incorrect 2-digit second" - lift $ modify _{second = Just ss} - cb a - Seconds a → do - ds ← some digit - let ss = foldDigits ds - when (Arr.length ds > 2 || ss < 0 || ss > 59) $ P.fail "Incorrect second" - lift $ modify _{second = Just ss} - cb a - Milliseconds a → do - ds ← some digit - let sss = foldDigits ds - when (Arr.length ds /= 3 || sss < 0 || sss > 999) $ P.fail "Incorrect millisecond" - lift $ modify _{millisecond = Just sss} - cb a - Placeholder s a → - PS.string s *> cb a - MillisecondsShort a → do - ds ← some digit - let s = foldDigits ds - when (Arr.length ds /= 1 || s < 0 || s > 9) $ P.fail "Incorrect 1-digit millisecond" - lift $ modify _{millisecond = Just s} - cb a - MillisecondsTwoDigits a → do - ds ← some digit - let ss = foldDigits ds - when (Arr.length ds /= 2 || ss < 0 || ss > 99) $ P.fail "Incorrect 2-digit millisecond" - lift $ modify _{millisecond = Just ss} - cb a - End → - pure unit - - -unformatParser ∷ Formatter → P.ParserT String (State UnformatAccum) Unit -unformatParser f = - unformatFParser unformatParser $ unroll f + Just (DT.DateTime d t) → lift $ put + { year: Just $ fromEnum $ D.year d + , month: Just $ fromEnum $ D.month d + , day: Just $ fromEnum $ D.day d + , hour: Just $ fromEnum $ T.hour t + , minute: Just $ fromEnum $ T.minute t + , second: Just $ fromEnum $ T.second t + , millisecond: Just $ fromEnum $ T.millisecond t + , meridiem: Nothing + } + -- TODO we would need to use this value if we support date format using week number + DayOfWeek → void $ parseInt 1 (validateRange 1 7) "Incorrect day of week" + Hours24 → _{hour = _} `modifyWithParser` + (parseInt 2 (validateRange 0 23 <> exactLength) "Incorrect 24 hour") + Hours12 → _{hour = _} `modifyWithParser` + (parseInt 2 (validateRange 0 11 <> exactLength) "Incorrect 12 hour") + Meridiem → _{meridiem = _} `modifyWithParser` parseMeridiem + MinutesTwoDigits → _{minute = _} `modifyWithParser` + (parseInt 2 (validateRange 0 59 <> exactLength) "Incorrect 2-digit minute") + Minutes → _{minute = _} `modifyWithParser` + (parseInt 2 (validateRange 0 59) "Incorrect minute") + SecondsTwoDigits → _{second = _} `modifyWithParser` + (parseInt 2 (validateRange 0 59 <> exactLength) "Incorrect 2-digit second") + Seconds → _{second = _} `modifyWithParser` + (parseInt 2 (validateRange 0 59) "Incorrect second") + Milliseconds → _{millisecond = _} `modifyWithParser` + (parseInt 3 exactLength "Incorrect millisecond") + Placeholder s → void $ PS.string s + MillisecondsShort → _{millisecond = _} `modifyWithParser` + (parseInt 1 exactLength "Incorrect 1-digit millisecond" <#> (_ * 100)) + MillisecondsTwoDigits → _{millisecond = _} `modifyWithParser` + (parseInt 2 exactLength "Incorrect 2-digit millisecond" <#> (_ * 10)) + where + modifyWithParser ∷ ∀ s' s x. (s → Maybe x → s) → P.ParserT s' (State s) x → P.ParserT s' (State s) Unit + modifyWithParser f p = do + v ← p + lift $ modify (flip f (Just v)) + +unformatParser ∷ ∀ m. Monad m ⇒ Formatter → P.ParserT String m DT.DateTime +unformatParser f = do + acc ← P.mapParserT unState $ foldMap unformatCommandParser f + either P.fail pure $ unformatAccumToDateTime acc + where + unState ∷ ∀ x y n. Monad n ⇒ State UnformatAccum (Tuple (Either y Unit) x) → n (Tuple (Either y UnformatAccum) x) + unState s = case runState s initialAccum of + Tuple (Tuple e state) res → pure (Tuple (e $> res) state) + + unformatDateTime ∷ String → String → Either String DT.DateTime unformatDateTime pattern str = - parseFormatString pattern >>= flip unformat str + parseFormatString pattern >>= (_ `unformat` str) + +parseMeridiem ∷ ∀ m. Monad m ⇒ P.ParserT String m Meridiem +parseMeridiem = (PC.try <<< PS.string) `oneOfAs` + [ Tuple "am" AM + , Tuple "AM" AM + , Tuple "pm" PM + , Tuple "PM" PM + ] parseMonth ∷ ∀ m. Monad m ⇒ P.ParserT String m D.Month -parseMonth = - PC.choice - [ (PC.try $ PS.string "January") $> D.January - , (PC.try $ PS.string "February") $> D.February - , (PC.try $ PS.string "March") $> D.March - , (PC.try $ PS.string "April") $> D.April - , (PC.try $ PS.string "May") $> D.May - , (PC.try $ PS.string "June") $> D.June - , (PC.try $ PS.string "July") $> D.July - , (PC.try $ PS.string "August") $> D.August - , (PC.try $ PS.string "September") $> D.September - , (PC.try $ PS.string "October") $> D.October - , (PC.try $ PS.string "November") $> D.November - , (PC.try $ PS.string "December") $> D.December - ] +parseMonth = (PC.try <<< PS.string) `oneOfAs` + [ Tuple "January" D.January + , Tuple "February" D.February + , Tuple "March" D.March + , Tuple "April" D.April + , Tuple "May" D.May + , Tuple "June" D.June + , Tuple "July" D.July + , Tuple "August" D.August + , Tuple "September" D.September + , Tuple "October" D.October + , Tuple "November" D.November + , Tuple "December" D.December + ] parseShortMonth ∷ ∀ m. Monad m ⇒ P.ParserT String m D.Month -parseShortMonth = - PC.choice - [ (PC.try $ PS.string "Jan") $> D.January - , (PC.try $ PS.string "Feb") $> D.February - , (PC.try $ PS.string "Mar") $> D.March - , (PC.try $ PS.string "Apr") $> D.April - , (PC.try $ PS.string "May") $> D.May - , (PC.try $ PS.string "Jun") $> D.June - , (PC.try $ PS.string "Jul") $> D.July - , (PC.try $ PS.string "Aug") $> D.August - , (PC.try $ PS.string "Sep") $> D.September - , (PC.try $ PS.string "Oct") $> D.October - , (PC.try $ PS.string "Nov") $> D.November - , (PC.try $ PS.string "Dec") $> D.December - ] +parseShortMonth = (PC.try <<< PS.string) `oneOfAs` + [ Tuple "Jan" D.January + , Tuple "Feb" D.February + , Tuple "Mar" D.March + , Tuple "Apr" D.April + , Tuple "May" D.May + , Tuple "Jun" D.June + , Tuple "Jul" D.July + , Tuple "Aug" D.August + , Tuple "Sep" D.September + , Tuple "Oct" D.October + , Tuple "Nov" D.November + , Tuple "Dec" D.December + ] printShortMonth ∷ D.Month → String printShortMonth = case _ of diff --git a/src/Data/Formatter/Internal.purs b/src/Data/Formatter/Internal.purs index 9106c43..2a91ab7 100644 --- a/src/Data/Formatter/Internal.purs +++ b/src/Data/Formatter/Internal.purs @@ -5,28 +5,9 @@ import Prelude import Data.Foldable (class Foldable, foldl) import Data.Monoid (class Monoid, mempty) -import Text.Parsing.Parser as P -import Text.Parsing.Parser.String as PS - foldDigits ∷ ∀ f. Foldable f ⇒ f Int → Int foldDigits = foldl (\acc d → acc * 10 + d) zero -digit ∷ ∀ m. Monad m ⇒ P.ParserT String m Int -digit = do - char ← PS.oneOf ['0','1','2','3','4','5','6','7','8','9'] - case char of - '0' → pure 0 - '1' → pure 1 - '2' → pure 2 - '3' → pure 3 - '4' → pure 4 - '5' → pure 5 - '6' → pure 6 - '7' → pure 7 - '8' → pure 8 - '9' → pure 9 - _ → P.fail "Incorrect digit, impossible situation" - repeat ∷ ∀ a. Monoid a ⇒ a → Int → a repeat = repeat' mempty where diff --git a/src/Data/Formatter/Interval.purs b/src/Data/Formatter/Interval.purs new file mode 100644 index 0000000..7da3f44 --- /dev/null +++ b/src/Data/Formatter/Interval.purs @@ -0,0 +1,61 @@ +module Data.Formatter.Interval + ( unformatRecurringInterval + , unformatInterval + , formatRecurringInterval + , formatInterval + ) where + +import Prelude + +import Data.DateTime (DateTime) +import Data.Either (Either) +import Data.Foldable (foldMap) +import Data.Formatter.DateTime as FDT +import Data.Formatter.Parser.Interval (parseRecurringInterval, parseInterval, parseIsoDuration, parseDateTime, extendedDateTimeFormatInUTC) +import Data.Formatter.Parser.Utils (runP) +import Data.Int as Int +import Data.Interval as I +import Data.Interval.Duration.Iso (IsoDuration, unIsoDuration) +import Data.Map (lookup) +import Data.Maybe (maybe) +import Data.Monoid (mempty) +import Data.Tuple (Tuple(..)) + +formatRecurringInterval ∷ I.RecurringInterval IsoDuration DateTime → String +formatRecurringInterval (I.RecurringInterval n i) = "R" <> (maybe "" formatInteger n) <> "/" <> (formatInterval i) + +formatInterval ∷ I.Interval IsoDuration DateTime → String +formatInterval (I.StartEnd x y) = (formatDateTime x) <> "/" <> (formatDateTime y) +formatInterval (I.DurationEnd d x) = (formatIsoDuration d) <> "/" <> (formatDateTime x) +formatInterval (I.StartDuration x d) = (formatDateTime x) <> "/" <> (formatIsoDuration d) +formatInterval (I.DurationOnly d) = (formatIsoDuration d) + +formatDateTime ∷ DateTime → String +formatDateTime = FDT.format extendedDateTimeFormatInUTC + +formatIsoDuration ∷ IsoDuration → String +formatIsoDuration = formatDuration <<< unIsoDuration + +formatDuration ∷ I.Duration → String +formatDuration (I.Duration m) = "P" <> datePart <> timePart + where + datePart = componentToString `foldMap` dateComponentsToStr + timePart = ("T" <> _) `ifmempty` (componentToString `foldMap` timeComponentsToStr) + ifmempty _ a | a == mempty = mempty + ifmempty f a = f a + componentToString (Tuple k s) = maybe "" (formatComponent s) $ lookup k m + formatComponent designator num = formatNumber num <> designator + dateComponentsToStr = [ Tuple I.Year "Y", Tuple I.Month "M", Tuple I.Week "W", Tuple I.Day "D" ] + timeComponentsToStr = [ Tuple I.Hour "H", Tuple I.Minute "M", Tuple I.Second "S" ] + +formatInteger ∷ Int → String +formatInteger = show + +formatNumber ∷ Number → String +formatNumber n = if Int.toNumber (Int.floor n) == n then show (Int.floor n) else show n + +unformatRecurringInterval ∷ String → Either String (I.RecurringInterval IsoDuration DateTime) +unformatRecurringInterval = runP $ parseRecurringInterval parseIsoDuration parseDateTime + +unformatInterval ∷ String → Either String (I.Interval IsoDuration DateTime) +unformatInterval = runP $ parseInterval parseIsoDuration parseDateTime diff --git a/src/Data/Formatter/Number.purs b/src/Data/Formatter/Number.purs index 4b4c701..4c44dab 100644 --- a/src/Data/Formatter/Number.purs +++ b/src/Data/Formatter/Number.purs @@ -3,7 +3,7 @@ -- | zeros and put commas between thousands should be enough for everything -- | because one could just compose it with `flip append "%"` or whatever module Data.Formatter.Number - ( Formatter + ( Formatter(..) , printFormatter , parseFormatString , format @@ -15,7 +15,6 @@ module Data.Formatter.Number import Prelude -import Data.Bifunctor (lmap) import Data.Array as Arr import Data.Array (many, some) import Data.Maybe (Maybe(..), fromMaybe, isJust) @@ -24,7 +23,9 @@ import Data.Either (Either, either) import Data.Int as Int import Data.String as Str -import Data.Formatter.Internal (foldDigits, digit, repeat) +import Data.Formatter.Parser.Utils (runP) +import Data.Formatter.Internal (foldDigits, repeat) +import Data.Formatter.Parser.Number (parseDigit) import Math as Math @@ -32,7 +33,12 @@ import Text.Parsing.Parser as P import Text.Parsing.Parser.Combinators as PC import Text.Parsing.Parser.String as PS -type Formatter = +import Data.Newtype (class Newtype) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) + + +newtype Formatter = Formatter { comma ∷ Boolean , before ∷ Int , after ∷ Int @@ -40,9 +46,16 @@ type Formatter = , sign ∷ Boolean } +derive instance genericFormatter ∷ Generic Formatter _ +derive instance newtypeFormatter ∷ Newtype Formatter _ + +instance showFormatter ∷ Show Formatter where + show = genericShow + +derive instance eqFormatter ∷ Eq Formatter printFormatter ∷ Formatter → String -printFormatter f = +printFormatter (Formatter f) = (if f.sign then "+" else "") <> repeat "0" (f.before - one) <> (if f.comma then "0,0" else "0") @@ -51,8 +64,7 @@ printFormatter f = <> (if f.abbreviations then "a" else "") parseFormatString ∷ String → Either String Formatter -parseFormatString s = - lmap P.parseErrorMessage $ P.runParser s formatParser +parseFormatString = runP formatParser formatParser ∷ P.Parser String Formatter @@ -65,16 +77,17 @@ formatParser = do PC.try $ many $ PS.string "0" abbreviations ← PC.optionMaybe $ PC.try $ PS.string "a" - pure { sign: isJust sign - , before: Arr.length before - , comma: isJust comma - , after: fromMaybe zero $ Arr.length <$> after - , abbreviations: isJust abbreviations - } + pure $ Formatter + { sign: isJust sign + , before: Arr.length before + , comma: isJust comma + , after: fromMaybe zero $ Arr.length <$> after + , abbreviations: isJust abbreviations + } format ∷ Formatter → Number → String -format f num = +format (Formatter f) num = let absed = Math.abs num tens = if absed > 0.0 then Int.floor $ Math.log absed / Math.ln10 else 0 @@ -94,7 +107,7 @@ format f num = | otherwise = "10e+" <> show (thousands * 3) newNum = if thousands < 1 then num else num / Math.pow 1000.0 (Int.toNumber thousands) in - format f{abbreviations = false} newNum <> abbr + format (Formatter f{abbreviations = false}) newNum <> abbr else let zeros = f.before - tens - one @@ -130,11 +143,10 @@ format f num = unformat ∷ Formatter → String → Either String Number -unformat f s = - lmap P.parseErrorMessage $ P.runParser s $ unformatParser f +unformat = runP <<< unformatParser unformatParser ∷ Formatter → P.Parser String Number -unformatParser f = do +unformatParser (Formatter f) = do minus ← PC.optionMaybe $ PC.try $ PS.string "-" sign ← case minus of Nothing | f.sign → @@ -149,13 +161,13 @@ unformatParser f = do digitsWithCommas = if not f.comma then do - some digit <* PS.string "." + some parseDigit <* PS.string "." else digitsWithCommas' [ ] digitsWithCommas' ∷ Array Int → P.Parser String (Array Int) digitsWithCommas' accum = do - ds ← some digit + ds ← some parseDigit when (Arr.null accum && Arr.length ds > 3) $ P.fail "Wrong number of digits between thousand separators" @@ -174,7 +186,7 @@ unformatParser f = do then P.fail "Error: too few digits before dot" else pure $ Int.toNumber $ foldDigits beforeDigits - afterDigits ← some digit + afterDigits ← some parseDigit after ← if Arr.length afterDigits < f.after then P.fail "Error: too few digits after dot" @@ -191,7 +203,7 @@ unformatParser f = do Nothing → pure 0 Just _ → - map foldDigits $ many digit + map foldDigits $ many parseDigit Just 'K' → pure 3 Just 'M' → pure 6 Just 'G' → pure 9 diff --git a/src/Data/Formatter/Parser/Interval.purs b/src/Data/Formatter/Parser/Interval.purs new file mode 100644 index 0000000..3446b04 --- /dev/null +++ b/src/Data/Formatter/Parser/Interval.purs @@ -0,0 +1,81 @@ +module Data.Formatter.Parser.Interval + ( parseRecurringInterval + , parseInterval + , parseIsoDuration + , parseDateTime + , extendedDateTimeFormatInUTC + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Data.DateTime (DateTime) +import Data.Either (Either(..), fromRight) +import Data.Foldable (class Foldable, fold, foldMap, intercalate) +import Data.Formatter.DateTime (unformatParser, Formatter, parseFormatString) +import Data.Formatter.Parser.Number (parseNumber, parseMaybeInteger) +import Data.Interval as I +import Data.Interval.Duration.Iso (IsoDuration, mkIsoDuration, prettyError) +import Data.Maybe (Maybe) +import Data.Monoid (class Monoid, mempty) +import Data.Traversable (sequence) +import Data.Tuple (Tuple(..), snd) +import Partial.Unsafe (unsafePartial) +import Text.Parsing.Parser as P +import Text.Parsing.Parser.Combinators as PC +import Text.Parsing.Parser.String as PS + +parseRecurringInterval ∷ ∀ a b. P.Parser String a → P.Parser String b → P.Parser String (I.RecurringInterval a b) +parseRecurringInterval duration date = + I.RecurringInterval <$> (PS.string "R" *> parseMaybeInteger) <*> (PS.string "/" *> parseInterval duration date) + +parseInterval ∷ ∀ a b. P.Parser String a → P.Parser String b → P.Parser String (I.Interval a b) +parseInterval duration date = [startEnd, durationEnd, startDuration, durationOnly] <#> PC.try # PC.choice + where + startEnd = I.StartEnd <$> date <* PS.string "/" <*> date + durationEnd = I.DurationEnd <$> duration <* PS.string "/" <*> date + startDuration = I.StartDuration <$> date <* PS.string "/" <*> duration + durationOnly = I.DurationOnly <$> duration + +parseIsoDuration ∷ P.Parser String IsoDuration +parseIsoDuration = do + dur ← parseDuration + case mkIsoDuration dur of + Left errs → + let errorStr = intercalate ", " (prettyError <$> errs) + in P.fail $ "Extracted Duration is not valid ISO duration (" <> errorStr <> ")" + Right a → pure a + +parseDuration ∷ P.Parser String I.Duration +parseDuration = PS.string "P" *> (weekDuration <|> fullDuration) + where + weekDuration = mkComponentsParser [ Tuple I.week "W" ] + fullDuration = (append <$> durationDatePart <*> durationTimePart) `failIfEmpty` "Must contain valid duration components" + durationDatePart = PC.option mempty $ PC.try $ mkComponentsParser [ Tuple I.year "Y" , Tuple I.month "M" , Tuple I.day "D" ] + durationTimePart = PC.option mempty $ (PC.try $ PS.string "T") *> (mkComponentsParser [ Tuple I.hour "H" , Tuple I.minute "M" , Tuple I.second "S" ]) + + +failIfEmpty ∷ ∀ a. Monoid a ⇒ Eq a ⇒ P.Parser String a → String → P.Parser String a +failIfEmpty p str = p >>= \x → if x == mempty then P.fail str else pure x + +mkComponentsParser ∷ Array (Tuple (Number → I.Duration) String) → P.Parser String I.Duration +mkComponentsParser arr = p `failIfEmpty` ("None of valid duration components (" <> (show $ snd <$> arr) <> ") were present") + where + p = arr <#> applyDurations # sequence <#> foldFoldableMaybe + applyDurations ∷ Tuple (Number → I.Duration) String → P.Parser String (Maybe I.Duration) + applyDurations (Tuple f c) = PC.optionMaybe $ PC.try (f <$> component c) + + foldFoldableMaybe ∷ ∀ f a. Foldable f ⇒ Monoid a ⇒ f (Maybe a) → a + foldFoldableMaybe = foldMap fold + + component ∷ String → P.Parser String Number + component designator = parseNumber <* PS.string designator + + +-- parser for DateTime in UTC time zone using "extended format" +parseDateTime ∷ ∀ m. Monad m ⇒ P.ParserT String m DateTime +parseDateTime = unformatParser extendedDateTimeFormatInUTC + +extendedDateTimeFormatInUTC ∷ Formatter +extendedDateTimeFormatInUTC = parseFormatString "YYYY-MM-DDTHH:mm:ssZ" + # unsafePartial fromRight -- the format must be valid ISO date format diff --git a/src/Data/Formatter/Parser/Number.purs b/src/Data/Formatter/Parser/Number.purs new file mode 100644 index 0000000..3136820 --- /dev/null +++ b/src/Data/Formatter/Parser/Number.purs @@ -0,0 +1,49 @@ +module Data.Formatter.Parser.Number + ( parseInteger + , parseMaybeInteger + , parseNumber + , parseDigit + ) where + +import Prelude + +import Data.Int (toNumber) +import Data.Array (some) +import Data.Formatter.Parser.Number (parseDigit) +import Data.Formatter.Internal (foldDigits) +import Data.Tuple (Tuple(..)) +import Text.Parsing.Parser as P +import Text.Parsing.Parser.Combinators as PC +import Data.Formatter.Parser.Utils (oneOfAs) +import Text.Parsing.Parser.String as PS +import Data.Maybe (Maybe) +import Data.Foldable (foldMap) +import Global (readFloat) + +parseInteger ∷ ∀ s m. Monad m ⇒ PS.StringLike s ⇒ P.ParserT s m Int +parseInteger = some parseDigit <#> foldDigits + +parseMaybeInteger ∷ ∀ s m. Monad m ⇒ PS.StringLike s ⇒ P.ParserT s m (Maybe Int) +parseMaybeInteger = PC.optionMaybe parseInteger + +parseFractional ∷ ∀ s m. Monad m ⇒ PS.StringLike s ⇒ P.ParserT s m Number +parseFractional = (some parseDigit) <#> (foldMap show >>> ("0." <> _) >>> readFloat) + +parseNumber ∷ ∀ s m. Monad m ⇒ PS.StringLike s ⇒ P.ParserT s m Number +parseNumber = (+) + <$> (parseInteger <#> toNumber) + <*> (PC.option 0.0 $ PC.try $ PS.oneOf ['.', ','] *> parseFractional) + + +parseDigit ∷ ∀ s m. Monad m ⇒ PS.StringLike s ⇒ P.ParserT s m Int +parseDigit = PC.try $ PS.char `oneOfAs` + [ Tuple '0' 0 + , Tuple '1' 1 + , Tuple '2' 2 + , Tuple '3' 3 + , Tuple '4' 4 + , Tuple '5' 5 + , Tuple '6' 6 + , Tuple '7' 7 + , Tuple '8' 8 + , Tuple '9' 9] diff --git a/src/Data/Formatter/Parser/Utils.purs b/src/Data/Formatter/Parser/Utils.purs new file mode 100644 index 0000000..e65af25 --- /dev/null +++ b/src/Data/Formatter/Parser/Utils.purs @@ -0,0 +1,27 @@ +module Data.Formatter.Parser.Utils + ( oneOfAs + , runP + ) where + +import Prelude + +import Data.Tuple (Tuple(..)) +import Text.Parsing.Parser (ParserT, Parser, runParser, ParseError, parseErrorMessage, parseErrorPosition) +import Text.Parsing.Parser.Pos (Position(..)) +import Text.Parsing.Parser.Combinators as PC +import Text.Parsing.Parser.String as PS +import Data.Bifunctor (lmap) +import Data.Foldable (class Foldable) +import Data.Either (Either) + +oneOfAs ∷ ∀ c s m f a b. Functor f ⇒ Foldable f ⇒ Monad m ⇒ (a → ParserT s m b) → f (Tuple a c) → ParserT s m c +oneOfAs p xs = PC.choice $ (\(Tuple s r) → p s $> r) <$> xs + +runP ∷ ∀ s a. PS.StringLike s ⇒ Parser s a → s → Either String a +runP p s = lmap printError $ runParser s (p <* PS.eof) + +printError ∷ ParseError → String +printError err = parseErrorMessage err <> "@" <> (printPosition $ parseErrorPosition err) + +printPosition ∷ Position → String +printPosition (Position {line, column}) = show line <> ":" <> show column diff --git a/test/src/DateTime.purs b/test/src/DateTime.purs new file mode 100644 index 0000000..6b5df2e --- /dev/null +++ b/test/src/DateTime.purs @@ -0,0 +1,175 @@ +module Test.DateTime (datetimeTest) where + +import Prelude + +import Data.Formatter.DateTime as FDT +import Data.List (fromFoldable) +import Data.DateTime (DateTime) +import Data.Either (Either(..)) +import Control.MonadZero (guard) +import Control.Alternative (class Alternative, empty) +import Test.Spec (describe, Spec) +import Test.Spec.Assertions (shouldEqual) +import Test.Utils (forAll, makeDateTime) + +datetimeTest ∷ ∀ e. Spec e Unit +datetimeTest = describe "Data.Formatter.DateTime" do + forAll (\a → a.format <> " | " <> a.dateStr) + "formatDateTime/unformaDateTime should formatt/unforma dateTime" + [ { format: "MM/DD/YYYY", dateStr: "04/12/2017" , date: makeDateTime 2017 4 12 11 3 4 234} + , { format: "MMMM", dateStr: "April" , date: makeDateTime 2017 4 12 11 3 4 234} + , { format: "YYYY-DD-MM", dateStr: "2017-12-04" , date: makeDateTime 2017 4 12 11 3 4 234} + , { format: "YYYY-MMM", dateStr: "2017-Apr" , date: makeDateTime 2017 4 12 11 3 4 234} + , { format: "MMM D", dateStr: "Apr 1" , date: makeDateTime 2017 4 1 0 0 0 0} + , { format: "hh:mm:ss:SSS a", dateStr: "11:03:04:234 AM" , date: makeDateTime 2017 4 12 11 3 4 234} + , { format: "YY", dateStr: "17" , date: makeDateTime 2017 4 12 11 3 4 234} + , { format: "YY", dateStr: "17" , date: makeDateTime 20017 4 12 0 0 0 0} -- Format 20017 with YY + , { format: "YY", dateStr: "00" , date: makeDateTime 0 4 12 0 0 0 0} -- Format 0 with YY + , { format: "YY", dateStr: "01" , date: makeDateTime (-1) 4 12 0 0 0 0} -- Format -1 with YY + , { format: "hh:m:s a", dateStr: "11:3:4 AM", date: makeDateTime 2017 4 12 11 3 4 234 } + , { format: "hh:mm:ss a", dateStr: "11:03:04 AM", date: makeDateTime 2017 4 12 11 3 4 234 } + , { format: "hh:mm:ss.SSS", dateStr: "11:12:30.123", date: makeDateTime 2017 4 10 11 12 30 123 } + , { format: "hh:mm:ss.SSS", dateStr: "11:12:30.023", date: makeDateTime 2017 4 10 11 12 30 23 } + , { format: "hh:mm:ss.SSS", dateStr: "11:12:30.003", date: makeDateTime 2017 4 10 11 12 30 3 } + , { format: "hh:mm:ss.SS", dateStr: "11:12:30.12", date: makeDateTime 2017 4 10 11 12 30 123 } + , { format: "hh:mm:ss.S", dateStr: "11:12:30.1", date: makeDateTime 2017 4 10 11 12 30 123 } + , { format: "hhmmss a", dateStr: "110304 AM", date: makeDateTime 2017 4 12 11 3 4 234 } + , { format: "hhmmssSSS", dateStr: "111230123", date: makeDateTime 2017 4 10 11 12 30 123 } + , { format: "hhmmssSSS", dateStr: "111230023", date: makeDateTime 2017 4 10 11 12 30 23 } + , { format: "hhmmssSSS", dateStr: "111230003", date: makeDateTime 2017 4 10 11 12 30 3 } + , { format: "hhmmssSS", dateStr: "11123012", date: makeDateTime 2017 4 10 11 12 30 123 } + , { format: "hhmmssS", dateStr: "1112301", date: makeDateTime 2017 4 10 11 12 30 123 } + , { format: "HHmmssSSS", dateStr: "134530123", date: makeDateTime 2017 4 10 13 45 30 123 } + , { format: "HHmm", dateStr: "1345", date: makeDateTime 2017 4 10 13 45 30 123 } + ] + (\({ format, dateStr, date }) → do + (format `FDT.formatDateTime` date) `shouldEqual` (Right dateStr) + (void $ format `FDT.unformatDateTime` dateStr) `shouldEqual` (Right unit) + ) + + describe "parseFormatString" do + forAll + _.str + "should parse" + dateformats + (\f → (FDT.parseFormatString f.str) `shouldEqual` (Right f.format)) + + forAll + _.str + "shouldn't parse" + invalidDateformats + (\f → (FDT.parseFormatString f.str) `shouldEqual` (Left $ "Expected EOF@" <> f.pos)) + + forAll + (\a → a.format <> " | " <> a.date) + "s ≡ format (unformat s)" + [ {date: "2017-12-04 234", format: "YYYY-DD-MM SSS" } + , {date: "3456-09-10 333", format: "YYYY-DD-MM SSS" } + , {date: "111230003", format: "hhmmssSSS"} + , {date: "11123012", format: "hhmmssSS"} + , {date: "1112301", format: "hhmmssS"} + + ] + (\({date, format}) → (FDT.unformatDateTime format date >>= FDT.formatDateTime format) `shouldEqual` (Right date)) + + forAll + (\a → show a.date <> "|" <> FDT.printFormatter a.format) + "s ≡ unformat (format s)" + (do + format ← dateformats + date ← dates + guard format.lossless + pure { date, format: format.format }) + (\({ date, format }) → FDT.unformat format (FDT.format format date) `shouldEqual` (Right date)) + + + +dates ∷ Array DateTime +dates = + [ makeDateTime 2017 4 12 11 3 4 234 + , makeDateTime 2017 4 1 0 0 0 0 + , makeDateTime 20017 4 12 0 0 0 0 + , makeDateTime 0 4 12 0 0 0 0 + , makeDateTime (-1) 4 12 0 0 0 0 + ] + +invalidDateformats ∷ Array { str ∷ String , pos ∷ String } +invalidDateformats = + [ { str: "YY-h-dddd HH:mm Z", pos: "1:4" } + , { str: "YYYY-MM-DD M", pos: "1:12" } + , { str: "YYYYM", pos: "1:5" } + ] + +dateformats ∷ Array { str ∷ String , lossless ∷ Boolean, format ∷ FDT.Formatter } +dateformats = + [ { str: "YYYY-MM-DD" + , lossless: false + , format: fromFoldable + [ FDT.YearFull + , FDT.Placeholder "-" + , FDT.MonthTwoDigits + , FDT.Placeholder "-" + , FDT.DayOfMonthTwoDigits + ] + } + , { str: "Y-MM-DD HH:mm:ss:SSS" + , lossless: true + , format: fromFoldable + [ FDT.YearAbsolute + , FDT.Placeholder "-" + , FDT.MonthTwoDigits + , FDT.Placeholder "-" + , FDT.DayOfMonthTwoDigits + , FDT.Placeholder " " + , FDT.Hours24 + , FDT.Placeholder ":" + , FDT.MinutesTwoDigits + , FDT.Placeholder ":" + , FDT.SecondsTwoDigits + , FDT.Placeholder ":" + , FDT.Milliseconds + ] + } + , { str: "YY-Z-DD HH:mm Z" + , lossless: false + , format: fromFoldable + [ FDT.YearTwoDigits + , FDT.Placeholder "-Z-" + , FDT.DayOfMonthTwoDigits + , FDT.Placeholder " " + , FDT.Hours24 + , FDT.Placeholder ":" + , FDT.MinutesTwoDigits + , FDT.Placeholder " Z" + ] + } + , { str: "DD-MM-YYYY trololo HH-:-mm" + , lossless: false + , format: fromFoldable + [ FDT.DayOfMonthTwoDigits + , FDT.Placeholder "-" + , FDT.MonthTwoDigits + , FDT.Placeholder "-" + , FDT.YearFull + , FDT.Placeholder " trololo " + , FDT.Hours24 + , FDT.Placeholder "-:-" + , FDT.MinutesTwoDigits + ] + } + , { str: "YYYY-DD-MM SSS" + , lossless: false + , format: fromFoldable + [ FDT.YearFull + , FDT.Placeholder "-" + , FDT.DayOfMonthTwoDigits + , FDT.Placeholder "-" + , FDT.MonthTwoDigits + , FDT.Placeholder " " + , FDT.Milliseconds + ] + } + ] + +filter ∷ ∀ m a. Alternative m ⇒ Monad m ⇒ (a → Boolean) → m a → m a +filter f m = m >>= \x → if f x then pure x else empty diff --git a/test/src/Interval.purs b/test/src/Interval.purs new file mode 100644 index 0000000..281db91 --- /dev/null +++ b/test/src/Interval.purs @@ -0,0 +1,178 @@ +module Test.Interval (intervalTest) where + +import Prelude + +import Control.Monad.Aff (Aff) +import Data.DateTime (DateTime) +import Data.Either (Either(..), fromRight) +import Data.Foldable (class Foldable, fold) +import Data.Formatter.Interval (unformatInterval, unformatRecurringInterval, formatRecurringInterval) +import Data.Formatter.Parser.Interval (parseIsoDuration) +import Data.Formatter.Parser.Utils (runP) +import Data.Interval as I +import Data.Interval.Duration.Iso (IsoDuration, mkIsoDuration) +import Data.Maybe (Maybe(..)) +import Partial.Unsafe (unsafePartial) +import Test.Spec (describe, Spec) +import Test.Spec.Assertions (shouldEqual) +import Test.Utils (forAll, makeDateTime) + +prop ∷ ∀ e e' f. Foldable f ⇒ String → f {str ∷ String | e'} → ({str ∷ String | e'} → Aff e Unit) → Spec e Unit +prop = forAll (show <<< _.str) + +intervalTest ∷ ∀ e. Spec e Unit +intervalTest = describe "Data.Formatter.Interval" do + prop "shouldn't unformat invalid Interval" invalidIntervals \({str, err}) → do + (unformatInterval str) `shouldEqual` (Left $ err) + + prop "shouldn't unformat invalid Duration" invalidDurations \({str, err}) → do + (runP parseIsoDuration str) `shouldEqual` (Left $ err) + + prop "should unformat RecurringInterval" arbRecurringInterval \({ str, interval }) → do + (unformatRecurringInterval str) `shouldEqual` (Right interval) + + prop "format (unformat s) = s" arbRecurringInterval \({ str, interval, formatedStr }) → do + (formatRecurringInterval <$> (unformatRecurringInterval str)) `shouldEqual` (Right formatedStr) + + prop "unformat (format s) = s" arbRecurringInterval \({ str, interval, formatedStr }) → do + (unformatRecurringInterval $ formatRecurringInterval interval) `shouldEqual` (Right interval) + + +unsafeMkToIsoDuration ∷ I.Duration → IsoDuration +unsafeMkToIsoDuration d = mkIsoDuration d + # unsafePartial fromRight -- the duration must be valid ISO duration + +durations ∷ Array { str∷ String, formatedStr∷ String, dur ∷ IsoDuration } +durations = + [ { str: "P1W", formatedStr: "P1W", dur: I.week 1.0 } + , { str: "P1.0W", formatedStr: "P1W", dur: I.week 1.0 } + , { str: "P1DT1H1M1S", formatedStr: "P1DT1H1M1S", dur: I.day 1.0 <> I.hour 1.0 <> I.minute 1.0 <> I.second 1.0 } + , { str: "P1.9748600D", formatedStr: "P1.97486D", dur: I.day 1.97486 } + , { str: "P1DT1H1M0S", formatedStr: "P1DT1H1M0S", dur: I.day 1.0 <> I.hour 1.0 <> I.minute 1.0 <> I.second 0.0 } + , { str: "P1DT1H1M1.5S", formatedStr: "P1DT1H1M1.5S", dur: I.day 1.0 <> I.hour 1.0 <> I.minute 1.0 <> I.second 1.5 } + , { str: "P1DT1H1.5M", formatedStr: "P1DT1H1.5M", dur: I.day 1.0 <> I.hour 1.0 <> I.minute 1.5 } + , { str: "P1DT1.5H", formatedStr: "P1DT1.5H", dur: I.day 1.0 <> I.hour 1.5 } + , { str: "PT1M", formatedStr: "PT1M", dur: I.minute 1.0 } + , { str: "PT1S", formatedStr: "PT1S", dur: I.second 1.0 } + , { str: "PT1H1S", formatedStr: "PT1H1S", dur: I.hour 1.0 <> I.second 1.0 } + ] <#> (\a → a { dur = unsafeMkToIsoDuration a.dur }) + +invalidDurations ∷ Array { err ∷ String, str ∷ String} +invalidDurations = + [ { err: errInvalidISO "Hour" <> "1:13", str: "P1DT1.5H0M1S" } + , { err: errInvalidISO "Year" <> "1:10", str: "P1.5Y0.5M" } + , { err: errInvalidISO "Year" <> "1:8", str: "P1.5Y1M" } + , { err: errInvalidISO "Month" <> "1:12", str: "P1.5MT10.5S" } + , { err: errInvalidComponent <> "1:2", str: "P" } + , { err: errInvalidComponent <> "1:2", str: "PW" } + , { err: errInvalidComponent <> "1:2", str: "PD" } + , { err: errNoTimeComponent <> "1:3", str: "PT" } + , { err: errNoTimeComponent <> "1:3", str: "PTH" } + , { err: errNoTimeComponent <> "1:5", str: "P1YT" } + , { err: errPrefix <> "1:1", str: "" } + , { err: errPrefix <> "1:1", str: "T" } + , { err: errPrefix <> "1:1", str: "~P1Y" } + , { err: errPrefix <> "1:1", str: ".P1Y" } + , { err: errEOF <> "1:4", str: "P1Y1W" } + ] + where + errInvalidComponent = "Must contain valid duration components@" + errPrefix = "Expected \"P\"@" + errEOF = "Expected EOF@" + errInvalidISO c = + "Extracted Duration is not valid ISO duration " <> + "(Invalid usage of Fractional value at component `" <> c <> "`)@" + errNoTimeComponent = "None of valid duration components ([\"H\",\"M\",\"S\"]) were present@" + +invalidIntervals ∷ Array {err ∷ String, str ∷ String} +invalidIntervals = + [ { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00ZP1Y2M10DT2H30M" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z-P1Y2M10D" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z~P1Y2M10D" } + , { err: "Expected EOF@1:15", str: "P1Y2M10DT2H30M2007-03-01T13:00:00Z" } + , { err: "Expected EOF@1:9", str: "P1Y2M10D-2007-03-01T13:00:00Z" } + , { err: "Expected EOF@1:9", str: "P1Y2M10D~2007-03-01T13:00:00Z" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z2008-05-11T15:30:00Z" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z-2008-05-11T15:30:00Z" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z~2008-05-11T15:30:00Z" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z/" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z/P" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z/PT" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z/2010-0-09" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z/2010-05-09T103012+0400" } + , { err: "Expected \"P\"@1:1", str: "2007-03-01T13:00:00Z/2014-W15-02T10:11:12Z" } + , { err: "Expected EOF@1:9", str: "P1Y2M10D/P1Y2M10D" } + , { err: "Expected EOF@1:8", str: "P1Y0.5M/P1Y0.5M" } + ] + +recurrences ∷ Array { str ∷ String, rec ∷ Maybe Int } +recurrences = + [ {str: "", rec: Nothing} + , {str: "18", rec: Just 18} + ] + +dates ∷ Array { str∷ String, date ∷ DateTime } +dates = + [ { str: "2015-07-23T11:12:13Z", date: makeDateTime 2015 7 23 11 12 13 0 } + , { str: "2015-07-22T00:00:00Z", date: makeDateTime 2015 7 22 0 0 0 0 } + ] + +type ArbRecurringInterval = Array { str ∷ String, formatedStr ∷ String, interval ∷ I.RecurringInterval IsoDuration DateTime} +type ArbInterval = Array { str ∷ String, formatedStr ∷ String, interval ∷ I.Interval IsoDuration DateTime} + +arbRecurringInterval ∷ ArbRecurringInterval +arbRecurringInterval = do + rec ← recurrences + i ← arbInterval + pure + { str : "R" <> rec.str <> "/" <> i.str + , formatedStr : "R" <> rec.str <> "/" <> i.formatedStr + , interval: I.RecurringInterval rec.rec i.interval + } + +arbInterval ∷ ArbInterval +arbInterval = fold + [ arbIntervalStartEnd + , arbIntervalDurationEnd + , arbIntervalStartDuration + , arbIntervalDurationOnly + ] + +arbIntervalStartEnd ∷ ArbInterval +arbIntervalStartEnd = do + start ← dates + end ← dates + pure + { str: start.str <> "/" <> end.str + , formatedStr: start.str <> "/" <> end.str + , interval: I.StartEnd start.date end.date + } + +arbIntervalDurationEnd ∷ ArbInterval +arbIntervalDurationEnd = do + dur ← durations + end ← dates + pure + { str: dur.str <> "/" <> end.str + , formatedStr: dur.formatedStr <> "/" <> end.str + , interval: I.DurationEnd dur.dur end.date + } + +arbIntervalStartDuration ∷ ArbInterval +arbIntervalStartDuration = do + dur ← durations + start ← dates + pure + { str: start.str <> "/" <> dur.str + , formatedStr: start.str <> "/" <> dur.formatedStr + , interval: I.StartDuration start.date dur.dur + } + +arbIntervalDurationOnly ∷ ArbInterval +arbIntervalDurationOnly = do + dur ← durations + pure + { str: dur.str + , formatedStr: dur.formatedStr + , interval: I.DurationOnly dur.dur + } diff --git a/test/src/Main.js b/test/src/Main.js deleted file mode 100644 index b089e4e..0000000 --- a/test/src/Main.js +++ /dev/null @@ -1,5 +0,0 @@ -'use strict'; - -exports.exit = function(int) { - process.exit(int); -} diff --git a/test/src/Main.purs b/test/src/Main.purs index 8b78730..97bab4e 100644 --- a/test/src/Main.purs +++ b/test/src/Main.purs @@ -1,231 +1,16 @@ module Test.Main where import Prelude -import Control.Monad.Aff.Console as AffC -import Data.Date as D -import Data.DateTime as DTi -import Data.Formatter.DateTime as FDT -import Data.Formatter.Number as FN -import Data.Time as T -import Debug.Trace as DT -import Control.Monad.Aff (Aff, Canceler, runAff) -import Control.Monad.Aff.Class (liftAff) -import Control.Monad.Eff (Eff, kind Effect) -import Control.Monad.Eff.Console (CONSOLE) -import Control.Monad.Eff.Exception (EXCEPTION, error) -import Control.Monad.Error.Class (throwError) -import Control.Monad.State (StateT, put, get, execStateT) -import Data.DateTime (DateTime) -import Data.Either (Either(..), either) -import Data.Enum (toEnum) -import Data.Functor.Mu (roll) -import Data.Maybe (fromMaybe) -type Tests e a = StateT Boolean (Aff (exception :: EXCEPTION, console :: CONSOLE | e)) a - - -execTests :: forall a e c. - StateT a (Aff ( process :: PROCESS | e)) c -> - a -> - Eff (process :: PROCESS | e) (Canceler ( process :: PROCESS | e )) -execTests fn state = runAff (\s -> exit 1) (\s -> exit 0) (execStateT fn state) - - -log :: forall e. String -> Tests e Unit -log message = liftAff $ AffC.log message - - -foreign import data PROCESS :: Effect -foreign import exit :: Int -> forall e. Eff (process :: PROCESS | e) Unit - - -fnOne ∷ FN.Formatter -fnOne = - { comma: false - , before: 3 - , after: 2 - , abbreviations: false - , sign: false - } - - -fnTwo ∷ FN.Formatter -fnTwo = - { comma: true - , before: one - , after: 4 - , abbreviations: false - , sign: true - } - - -fnThree ∷ FN.Formatter -fnThree = - { comma: false - , before: 2 - , after: 2 - , abbreviations: true - , sign: true - } - - -fdtOne ∷ FDT.Formatter -fdtOne = - roll $ FDT.Placeholder "format string is " - $ roll $ FDT.YearFull - $ roll $ FDT.Placeholder "-" - $ roll $ FDT.MonthShort - $ roll FDT.End - - -numeralTests :: forall e. Tests e Unit -numeralTests = do - log $ "\nNUMERAL TESTS\n" - - log $ "\nPRINT FORMATTER" - log $ FN.printFormatter fnOne - log $ FN.printFormatter fnTwo - log $ FN.printFormatter fnThree - - log $ "\nPARSE FORMAT STRING" - DT.traceAnyA $ FN.parseFormatString "000,0.00" - DT.traceAnyA $ FN.parseFormatString "000" - DT.traceAnyA $ FN.parseFormatString "0a" - DT.traceAnyA $ FN.parseFormatString "-0,0.000" - DT.traceAnyA $ FN.parseFormatString "+000.0" - - log $ "\n FORMAT" - log $ FN.format fnOne 100.2 - log $ FN.format fnTwo 100.1 - log $ FN.format fnThree 100.3 - log $ FN.format fnThree 10004000.0 - - log $ "\n UNFORMAT" - DT.traceAnyA $ FN.unformat fnOne "001.12" - DT.traceAnyA $ FN.unformat fnOne "-123.12" - DT.traceAnyA $ FN.unformat fnOne "12.12" - DT.traceAnyA $ FN.unformat fnThree "+123" - DT.traceAnyA $ FN.unformat fnTwo "-100,000.1234" - - log $ "\n FORMAT NUMBER" - DT.traceAnyA $ FN.formatNumber "00.00" 12.0 - DT.traceAnyA $ FN.formatNumber "00000,0.000" 123345.1235 - DT.traceAnyA $ FN.formatNumber "0.0" 123345.1235 - DT.traceAnyA $ FN.formatNumber "0.0" (-123345.1235) - - log $ "\n UNFORMAT NUMBER" - DT.traceAnyA $ FN.unformatNumber "0.00" "12.00" - - --- April 12th 2017 at 11:34:34:234 --- 4/12/2017 -makeDateTime ∷ Int -> Int -> Int -> Int -> Int -> Int -> Int -> DTi.DateTime -makeDateTime year month day hour minute second millisecond = - DTi.DateTime - (D.canonicalDate (fromMaybe bottom $ toEnum year) (fromMaybe bottom $ toEnum month) (fromMaybe bottom $ toEnum day)) - (T.Time - (fromMaybe bottom $ toEnum hour) - (fromMaybe bottom $ toEnum minute) - (fromMaybe bottom $ toEnum second) - (fromMaybe bottom $ toEnum millisecond)) - -testDateTime :: DTi.DateTime -testDateTime = makeDateTime 2017 4 12 11 3 4 234 - - -assert :: forall e. String -> String -> Boolean -> Tests e Unit -assert _ success true = log $ " ✓ - Passed - " <> success -assert fail _ false = do - log $ " ☠ - Failed because " <> fail - put false - - -failTest :: forall e. String -> Tests e Unit -failTest message = do - log message - put false - - -assertFormatting :: forall e. String -> String -> DateTime -> Tests e Unit -assertFormatting target' format dateTime = do - let result = FDT.formatDateTime format dateTime - let target = Right target' - assert - ((show result) <> " does not equal " <> (show target)) - ((show result) <> " equals " <> (show target)) - (result == target) - - -timeTest :: forall e. Tests e Unit -timeTest = do - log "- Data.Formatter.DateTime.formatDateTime" - - -- var a = moment( - -- 'April 12th 2017 at 11:34:34:234', - -- 'MMMM Do YYYY [at] HH:mm:ss:SSS' - -- ); - -- a.format('MMMM Do YYYY [at] HH:mm:ss:SSS') - -- testDateTime = April 12th 2017 at 11:34:34:234 - assertFormatting "04/12/2017" "MM/DD/YYYY" testDateTime - assertFormatting "April" "MMMM" testDateTime - assertFormatting "2017-12-04" "YYYY-DD-MM" testDateTime - assertFormatting "2017-Apr" "YYYY-MMM" testDateTime - assertFormatting "Apr 1" "MMM D" (makeDateTime 2017 4 1 0 0 0 0) - assertFormatting "Apr 01" "MMM DD" (makeDateTime 2017 4 1 0 0 0 0) - - -- This should probably be am (lowercase), if the desired - -- functionality of the library is to mirror momentjs - assertFormatting "11:3:4 AM" "hh:m:s a" testDateTime - assertFormatting "11:03:04 AM" "hh:mm:ss a" testDateTime - assertFormatting "11:12:30.123" "hh:mm:ss.SSS" (makeDateTime 2017 4 10 11 12 30 123) - assertFormatting "11:12:30.023" "hh:mm:ss.SSS" (makeDateTime 2017 4 10 11 12 30 23) - assertFormatting "11:12:30.003" "hh:mm:ss.SSS" (makeDateTime 2017 4 10 11 12 30 3) - assertFormatting "11:12:30.12" "hh:mm:ss.SS" (makeDateTime 2017 4 10 11 12 30 123) - assertFormatting "11:12:30.1" "hh:mm:ss.S" (makeDateTime 2017 4 10 11 12 30 123) - - assertFormatting "17" "YY" testDateTime - log " --- Format 20017 with YY" - assertFormatting "17" "YY" (makeDateTime 20017 4 12 0 0 0 0) - log " --- Format 0 with YY" - assertFormatting "00" "YY" (makeDateTime 0 4 12 0 0 0 0) - log " --- Format -1 with YY" - assertFormatting "01" "YY" (makeDateTime (-1) 4 12 0 0 0 0) - - log "- Data.Formatter.DateTime.unformatDateTime " - - let dt = FDT.unformatDateTime "YYYY-DD-MM SSS" "2017-12-04 234" - either - (const $ failTest "Could not parse 017-12-04 234") - (assertFormatting "2017-12-04 234" "YYYY-DD-MM SSS") - dt - -formattingTests :: forall e. Tests e Unit -formattingTests = do - log $ "\nPARSE FORMAT STRING" - - DT.traceAnyA $ FDT.parseFormatString "YYYY-MM-DD" - DT.traceAnyA $ FDT.parseFormatString "YY-Q-dddd HH:mm Z" - - log $ "\nFORMAT" - DT.traceAnyA $ FDT.parseFormatString "YYYY-MM-DD trololo Q" <#> flip FDT.format testDateTime - - log $ "\nUNFORMAT" - case FDT.parseFormatString "DD-MM-YYYY HH-:-mm" of - Left _ → DT.traceAnyA "?" - Right f → DT.traceAnyA $ FDT.unformat f "12-10-1345 04-:-32" - - log $ "\nUNFORMATDATETIME" - DT.traceAnyA $ FDT.unformatDateTime "YYYY-DD-MM SSS" "3456-09-10 333" - -main :: forall e. - Eff ( process :: PROCESS, exception :: EXCEPTION, console :: CONSOLE | e) - (Canceler ( process :: PROCESS, exception :: EXCEPTION, console :: CONSOLE | e)) -main = execTests tests true - where - tests = do - log "Testing time functions..." - timeTest - passed <- get - when (passed /= true) (throwError (error "Tests did not pass.")) - --numeralTests - --formattingTests +import Test.Interval (intervalTest) +import Test.DateTime (datetimeTest) +import Test.Number (numberTest) +import Test.Spec.Reporter.Console (consoleReporter) +import Control.Monad.Eff (Eff) +import Test.Spec.Runner (RunnerEffects, run) + +main ∷ Eff (RunnerEffects ()) Unit +main = run [consoleReporter] do + intervalTest + datetimeTest + numberTest diff --git a/test/src/Number.purs b/test/src/Number.purs new file mode 100644 index 0000000..4689bda --- /dev/null +++ b/test/src/Number.purs @@ -0,0 +1,81 @@ +module Test.Number (numberTest) where + +import Prelude + +import Data.Formatter.Number (Formatter(..), printFormatter, parseFormatString, format, unformat) +import Data.Either (Either(..)) + +import Test.Spec (describe, Spec) +import Test.Spec.Assertions (shouldEqual) +import Test.Utils (forAll) + +numberTest ∷ ∀ e. Spec e Unit +numberTest = describe "Data.Formatter.Number" do + forAll _.str + "should print formatter" + numberformatts + (\({fmt, str}) → printFormatter fmt `shouldEqual` str) + + forAll _.str + "parse format string" + numberformatts + (\({fmt, str}) → parseFormatString str `shouldEqual` (Right fmt)) + + forAll show + "unformat (format n) = n" + [100.2, 100.1, 100.3, 10004000.0] + (\n → unformat fmt1 (format fmt1 n) `shouldEqual` (Right n)) + + forAll show + "format (unformat n) = n" + [ "001.12" + ] + (\n → (format fmt1 <$> (unformat fmt1 n)) `shouldEqual` (Right n)) + + forAll show + "format (unformat n) = n" + --TODO negative nubers fail https://github.com/slamdata/purescript-formatters/issues/16 + [-- "-02.12" -- (Right "0-3.88") ≠ (Right "-02.12") + --, "-13.12" -- (Right "-14.88") ≠ (Right "-13.12") + ] + (\n → (format fmt3 <$> (unformat fmt3 n)) `shouldEqual` (Right n)) + +fmt1 ∷ Formatter +fmt1 = Formatter + { comma: false + , before: 3 + , after: 2 + , abbreviations: false + , sign: false + } + +fmt2 ∷ Formatter +fmt2 = Formatter + { comma: true + , before: 1 + , after: 4 + , abbreviations: false + , sign: true + } + +fmt3 ∷ Formatter +fmt3 = Formatter + { comma: false + , before: 2 + , after: 2 + , abbreviations: true + , sign: true + } + +numberformatts ∷ Array { fmt ∷ Formatter, str ∷ String } +numberformatts = + [ { str: "000.00" + , fmt: fmt1 + } + , { str: "+0,0.0000" + , fmt: fmt2 + } + , { str: "+00.00a" + , fmt: fmt3 + } + ] diff --git a/test/src/Utils.purs b/test/src/Utils.purs new file mode 100644 index 0000000..2bcc6d4 --- /dev/null +++ b/test/src/Utils.purs @@ -0,0 +1,32 @@ +module Test.Utils where + +import Prelude + + +import Test.Spec (describe, it, Spec) +import Control.Monad.Aff (Aff) + +import Data.Foldable (class Foldable, for_) +import Data.Enum (toEnum) +import Data.Maybe (fromMaybe) +import Data.DateTime (DateTime(..)) +import Data.Date (canonicalDate) +import Data.Time (Time(..)) + + +forAll ∷ ∀ e a f. Foldable f ⇒ (a → String) → String → f a → (a → Aff e Unit) → Spec e Unit +forAll itTitle title arb f = describe title do + for_ arb \a → it (itTitle a) (f a) + +makeDateTime ∷ Int → Int → Int → Int → Int → Int → Int → DateTime +makeDateTime year month day hour minute second millisecond = + DateTime + (canonicalDate + (fromMaybe bottom $ toEnum year) + (fromMaybe bottom $ toEnum month) + (fromMaybe bottom $ toEnum day)) + (Time + (fromMaybe bottom $ toEnum hour ) + (fromMaybe bottom $ toEnum minute ) + (fromMaybe bottom $ toEnum second ) + (fromMaybe bottom $ toEnum millisecond))