diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,20 @@ tomland uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +0.3.1 +===== +* [#19](https://github.com/kowainik/tomland/issues/19): + Add proper parsing of floating point numbers. +* [#15](https://github.com/kowainik/tomland/issues/15): + Add parsing of multiline strings +* [#40](https://github.com/kowainik/tomland/issues/40): + Support full-featured string parser +* [#18](https://github.com/kowainik/tomland/issues/18): + Add dates parsing. +* Add useful combinators for `newtype` wrappers. +* [#58](https://github.com/kowainik/tomland/issues/58): + Add `decodeFile` function. + 0.3 ===== diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/examples/Playground.hs b/examples/Playground.hs --- a/examples/Playground.hs +++ b/examples/Playground.hs @@ -12,6 +12,8 @@ import qualified Data.Text.IO as TIO import qualified Toml +newtype N = N Text + data Test = Test { testB :: Bool , testI :: Int @@ -21,6 +23,7 @@ , testM :: Maybe Bool , testX :: TestInside , testY :: Maybe TestInside + , testN :: N } newtype TestInside = TestInside { unInside :: Text } @@ -38,6 +41,7 @@ <*> Toml.maybeT Toml.bool "testM" .= testM <*> Toml.table insideT "testX" .= testX <*> Toml.maybeT (Toml.table insideT) "testY" .= testY + <*> Toml.wrapper Toml.text "testN" .= testN main :: IO () main = do diff --git a/src/Toml/Bi/Code.hs b/src/Toml/Bi/Code.hs --- a/src/Toml/Bi/Code.hs +++ b/src/Toml/Bi/Code.hs @@ -6,19 +6,24 @@ -- * Exceptions , DecodeException (..) + , LoadTomlException (..) , prettyException -- * Encode/Decode , decode + , decodeFile , encode ) where +import Control.Exception (Exception, throwIO) import Control.Monad.Except (ExceptT, runExceptT) +import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Reader (Reader, runReader) import Control.Monad.State (State, execState) +import Control.Monad.Trans.Maybe (MaybeT (..)) import Data.Bifunctor (first) import Data.Foldable (toList) -import Data.Semigroup ((<>)) +import Data.Semigroup (Semigroup (..)) import Data.Text (Text) import Toml.Bi.Monad (Bi, Bijection (..)) @@ -28,18 +33,29 @@ import Toml.Type (TOML (..), TValue, showType) import qualified Data.Text as Text +import qualified Data.Text.IO as TIO -- | Type of exception for converting from 'Toml' to user custom data type. data DecodeException - = KeyNotFound Key -- ^ No such key + = TrivialError + | KeyNotFound Key -- ^ No such key | TableNotFound Key -- ^ No such table | TypeMismatch Key Text TValue -- ^ Expected type vs actual type | ParseError ParseException -- ^ Exception during parsing deriving (Eq, Show) -- TODO: manual pretty show instances +instance Semigroup DecodeException where + TrivialError <> e = e + e <> _ = e + +instance Monoid DecodeException where + mempty = TrivialError + mappend = (<>) + -- | Converts 'DecodeException' into pretty human-readable text. prettyException :: DecodeException -> Text prettyException = \case + TrivialError -> "Using 'empty' parser" KeyNotFound name -> "Key " <> joinKey name <> " not found" TableNotFound name -> "Table [" <> joinKey name <> "] not found" TypeMismatch name expected actual -> "Expected type " <> expected <> " for key " <> joinKey name @@ -53,10 +69,17 @@ -- This is @r@ type variable in 'Bijection' data type. type Env = ExceptT DecodeException (Reader TOML) --- | Mutable context for 'Toml' conversion. --- This is @w@ type variable in 'Bijection' data type. -type St = State TOML +{- | Mutable context for 'Toml' conversion. +This is @w@ type variable in 'Bijection' data type. +@ +MaybeT (State TOML) a + = State TOML (Maybe a) + = TOML -> (Maybe a, TOML) +@ +-} +type St = MaybeT (State TOML) + -- | Specialied 'Bi' type alias for 'Toml' monad. Keeps 'TOML' object either as -- environment or state. type BiToml a = Bi Env St a @@ -69,4 +92,21 @@ -- | Convert object to textual representation. encode :: BiToml a -> a -> Text -encode bi obj = prettyToml $ execState (biWrite bi obj) mempty +encode bi obj = prettyToml $ execState (runMaybeT $ biWrite bi obj) mempty + +-- | File loading error data type. +data LoadTomlException = LoadTomlException FilePath Text + +instance Show LoadTomlException where + show (LoadTomlException filePath msg) = "Couldnt parse file " ++ filePath ++ ": " ++ show msg + +instance Exception LoadTomlException + +-- | Decode a value from a file. In case of parse errors, throws 'LoadTomlException'. +decodeFile :: (MonadIO m) => BiToml a -> FilePath -> m a +decodeFile biToml filePath = liftIO $ + (decode biToml <$> TIO.readFile filePath) >>= errorWhenLeft + where + errorWhenLeft :: Either DecodeException a -> IO a + errorWhenLeft (Left e) = throwIO $ LoadTomlException filePath $ prettyException e + errorWhenLeft (Right pc) = pure pc diff --git a/src/Toml/Bi/Combinators.hs b/src/Toml/Bi/Combinators.hs --- a/src/Toml/Bi/Combinators.hs +++ b/src/Toml/Bi/Combinators.hs @@ -23,11 +23,14 @@ , arrayOf , maybeT , table + , wrapper ) where import Control.Monad.Except (MonadError, catchError, throwError) import Control.Monad.Reader (asks, local) import Control.Monad.State (execState, gets, modify) +import Control.Monad.Trans.Maybe (runMaybeT) +import Data.Coerce (Coercible, coerce) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..)) import Data.Semigroup ((<>)) @@ -192,7 +195,7 @@ output a = do mTable <- gets $ Prefix.lookup key . tomlTables let toml = fromMaybe mempty mTable - let newToml = execState (biWrite bi a) toml + let newToml = execState (runMaybeT $ biWrite bi a) toml a <$ modify (insertTable key newToml) handleTableName :: DecodeException -> Env a @@ -200,3 +203,7 @@ handleTableName (TableNotFound name) = throwError $ TableNotFound (key <> name) handleTableName (TypeMismatch name t1 t2) = throwError $ TypeMismatch (key <> name) t1 t2 handleTableName e = throwError e + +-- | Used for @newtype@ wrappers. +wrapper :: forall b a . Coercible a b => (Key -> BiToml a) -> Key -> BiToml b +wrapper bi key = dimap coerce coerce (bi key) diff --git a/src/Toml/Bi/Monad.hs b/src/Toml/Bi/Monad.hs --- a/src/Toml/Bi/Monad.hs +++ b/src/Toml/Bi/Monad.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE UndecidableInstances #-} + -- | Contains general underlying monad for bidirectional TOML converion. module Toml.Bi.Monad @@ -7,6 +9,9 @@ , (.=) ) where +import Control.Applicative (Alternative (..)) +import Control.Monad (MonadPlus (..)) + {- | Monad for bidirectional Toml conversion. Contains pair of functions: 1. How to read value of type @a@ from immutable environment context @r@? @@ -66,6 +71,23 @@ { biRead = biRead bi >>= \a -> biRead (f a) , biWrite = \c -> biWrite bi c >>= \a -> biWrite (f a) c } + +instance (Alternative r, Alternative w) => Alternative (Bijection r w c) where + empty :: Bijection r w c a + empty = Bijection + { biRead = empty + , biWrite = \_ -> empty + } + + (<|>) :: Bijection r w c a -> Bijection r w c a -> Bijection r w c a + bi1 <|> bi2 = Bijection + { biRead = biRead bi1 <|> biRead bi2 + , biWrite = \c -> biWrite bi1 c <|> biWrite bi2 c + } + +instance (MonadPlus r, MonadPlus w) => MonadPlus (Bijection r w c) where + mzero = empty + mplus = (<|>) {- | This is an instance of 'Profunctor' for 'Bijection'. But since there's no @Profunctor@ type class in @base@ or package with no dependencies (and we don't diff --git a/src/Toml/Parser.hs b/src/Toml/Parser.hs --- a/src/Toml/Parser.hs +++ b/src/Toml/Parser.hs @@ -5,6 +5,7 @@ , parse , arrayP , boolP + , dateTimeP , doubleP , integerP , keyP @@ -16,18 +17,22 @@ -- I hate default Prelude... Do I really need to import all this stuff manually?.. import Control.Applicative (Alternative (..)) -import Control.Applicative.Combinators (between, manyTill, sepEndBy, skipMany) +import Control.Applicative.Combinators (between, count, manyTill, optional, sepEndBy, skipMany) import Control.Monad (void) -import Data.Char (digitToInt) +import Data.Char (chr, digitToInt, isControl) +import Data.Fixed (Pico) import Data.List (foldl') import Data.Semigroup ((<>)) import Data.Text (Text) +import Data.Time (LocalTime (..), ZonedTime (..), fromGregorianValid, makeTimeOfDayValid, + minutesToTimeZone) import Data.Void (Void) import Text.Megaparsec (Parsec, parseErrorPretty', try) -import Text.Megaparsec.Char (alphaNumChar, anyChar, char, oneOf, space1) +import Text.Megaparsec.Char (alphaNumChar, anyChar, char, digitChar, eol, hexDigitChar, oneOf, + satisfy, space, space1, string, tab) import Toml.PrefixTree (Key (..), Piece (..), fromList) -import Toml.Type (AnyValue, TOML (..), UValue (..), typeCheck) +import Toml.Type (AnyValue, DateTime (..), TOML (..), UValue (..), typeCheck) import qualified Control.Applicative.Combinators.NonEmpty as NC import qualified Data.HashMap.Lazy as HashMap @@ -59,13 +64,79 @@ text_ :: Text -> Parser () text_ = void . text -doubleP :: Parser Double -doubleP = L.signed sc $ lexeme L.float - ---------------------------------------------------------------------------- -- TOML parser ---------------------------------------------------------------------------- +-- Strings + +textP :: Parser Text +textP = multilineBasicStringP <|> multilineLiteralStringP <|> literalStringP <|> basicStringP + +nonControlCharP :: Parser Text +nonControlCharP = Text.singleton <$> satisfy (not . isControl) + +escapeSequenceP :: Parser Text +escapeSequenceP = char '\\' >> anyChar >>= \case + 'b' -> pure "\b" + 't' -> pure "\t" + 'n' -> pure "\n" + 'f' -> pure "\f" + 'r' -> pure "\r" + '"' -> pure "\"" + '\\' -> pure "\\" + 'u' -> hexUnicodeP 4 + 'U' -> hexUnicodeP 8 + c -> fail $ "Invalid escape sequence: " <> "\\" <> [c] + where + hexUnicodeP :: Int -> Parser Text + hexUnicodeP n = count n hexDigitChar + >>= \x -> case toUnicode $ hexToInt x of + Just c -> pure (Text.singleton c) + Nothing -> fail $ "Invalid unicode character: " <> "\\" <> (if n == 4 then "u" else "U") <> x + where + hexToInt :: String -> Int + hexToInt xs = read $ "0x" ++ xs + + toUnicode :: Int -> Maybe Char + toUnicode x + -- Ranges from "The Unicode Standard". + -- See definition D76 in Section 3.9, Unicode Encoding Forms. + | x >= 0 && x <= 0xD7FF = Just (chr x) + | x >= 0xE000 && x <= 0x10FFFF = Just (chr x) + | otherwise = Nothing + +basicStringP :: Parser Text +basicStringP = lexeme $ mconcat <$> (char '"' *> (escapeSequenceP <|> nonControlCharP) `manyTill` char '"') + +literalStringP :: Parser Text +literalStringP = lexeme $ Text.pack <$> (char '\'' *> nonEolCharP `manyTill` char '\'') + where + nonEolCharP :: Parser Char + nonEolCharP = satisfy (\c -> c /= '\n' && c /= '\r') + +multilineP :: Parser Text -> Parser Text -> Parser Text +multilineP quotesP allowedCharP = lexeme $ fmap mconcat $ quotesP >> optional eol >> allowedCharP `manyTill` quotesP + +multilineBasicStringP :: Parser Text +multilineBasicStringP = multilineP quotesP allowedCharP + where + quotesP = string "\"\"\"" + + allowedCharP :: Parser Text + allowedCharP = lineEndingBackslashP <|> escapeSequenceP <|> nonControlCharP <|> eol + + lineEndingBackslashP :: Parser Text + lineEndingBackslashP = Text.empty <$ try (char '\\' >> eol >> space) + +multilineLiteralStringP :: Parser Text +multilineLiteralStringP = multilineP quotesP allowedCharP + where + quotesP = string "'''" + + allowedCharP :: Parser Text + allowedCharP = nonControlCharP <|> eol <|> Text.singleton <$> tab + -- Keys bareKeyP :: Parser Text @@ -74,16 +145,6 @@ bareStrP :: Parser String bareStrP = some $ alphaNumChar <|> char '_' <|> char '-' -literalStringP :: Parser Text -literalStringP = lexeme $ Text.pack <$> (char '\'' *> anyChar `manyTill` char '\'') - --- TODO: this parser is incorrect, it doesn't recognize all strings -basicStringP :: Parser Text -basicStringP = lexeme $ Text.pack <$> (char '"' *> anyChar `manyTill` char '"') - -textP :: Parser Text -textP = literalStringP <|> basicStringP - -- adds " or ' to both sides quote :: Text -> Text -> Text quote q t = q <> t <> q @@ -110,13 +171,85 @@ mkNum b = foldl' (step b) 0 step b a c = a * b + fromIntegral (digitToInt c) +doubleP :: Parser Double +doubleP = lexeme $ L.signed sc (num <|> inf <|> nan) + where + num, inf, nan :: Parser Double + num = L.float + inf = 1 / 0 <$ string "inf" + nan = 0 / 0 <$ string "nan" + boolP :: Parser Bool boolP = False <$ text "false" <|> True <$ text "true" --- dateTimeP :: Parser DateTime --- dateTimeP = error "Not implemented!" +dateTimeP :: Parser DateTime +dateTimeP = lexeme $ try hoursP <|> dayLocalZoned + where + -- dayLocalZoned can parse: only a local date, a local date with time, or + -- a local date with a time and an offset + dayLocalZoned :: Parser DateTime + dayLocalZoned = do + let makeLocal (Day day) (Hours hours) = Local $ LocalTime day hours + makeLocal _ _ = error "Invalid arguments, unable to construct `Local`" + makeZoned (Local localTime) mins = Zoned $ ZonedTime localTime (minutesToTimeZone mins) + makeZoned _ _ = error "Invalid arguments, unable to construct `Zoned`" + day <- try dayP + maybeHours <- optional (try $ (char 'T' <|> char ' ') *> hoursP) + case maybeHours of + Nothing -> return day + Just hours -> do + maybeOffset <- optional (try timeOffsetP) + case maybeOffset of + Nothing -> return (makeLocal day hours) + Just offset -> return (makeZoned (makeLocal day hours) offset) + timeOffsetP :: Parser Int + timeOffsetP = z <|> numOffset + where + z = pure 0 <* char 'Z' + numOffset = do + sign <- char '+' <|> char '-' + hours <- int2DigitsP + _ <- char ':' + minutes <- int2DigitsP + let totalMinutes = hours * 60 + minutes + if sign == '+' + then return totalMinutes + else return (negate totalMinutes) + + hoursP :: Parser DateTime + hoursP = do + hours <- int2DigitsP + _ <- char ':' + minutes <- int2DigitsP + _ <- char ':' + seconds <- picoTruncated + case makeTimeOfDayValid hours minutes seconds of + Just time -> return (Hours time) + Nothing -> fail $ "Invalid time of day: " <> show hours <> ":" <> show minutes <> ":" <> show seconds + + dayP :: Parser DateTime + dayP = do + year <- integer4DigitsP + _ <- char '-' + month <- int2DigitsP + _ <- char '-' + day <- int2DigitsP + case fromGregorianValid year month day of + Just date -> return (Day date) + Nothing -> fail $ "Invalid date: " <> show year <> "-" <> show month <> "-" <> show day + + integer4DigitsP = (read :: String -> Integer) <$> count 4 digitChar + int2DigitsP = (read :: String -> Int) <$> count 2 digitChar + picoTruncated = do + let rdPico = read :: String -> Pico + int <- count 2 digitChar + frc <- optional (char '.' >> take 12 <$> some digitChar) + case frc of + Nothing -> return (rdPico int) + Just frc' -> return (rdPico $ int ++ "." ++ frc') + arrayP :: Parser [UValue] arrayP = lexeme $ between (char '[' *> sc) (char ']') elements where @@ -128,10 +261,10 @@ valueP :: Parser UValue valueP = UBool <$> boolP + <|> UDate <$> dateTimeP <|> UDouble <$> try doubleP <|> UInteger <$> integerP <|> UText <$> textP --- <|> UDate <$> dateTimeP <|> UArray <$> arrayP -- TOML diff --git a/test/Test/Toml/Parsing/Unit.hs b/test/Test/Toml/Parsing/Unit.hs --- a/test/Test/Toml/Parsing/Unit.hs +++ b/test/Test/Toml/Parsing/Unit.hs @@ -3,41 +3,57 @@ module Test.Toml.Parsing.Unit where import Data.Semigroup ((<>)) -import Test.Hspec.Megaparsec (shouldFailOn, shouldParse) +import Data.Time (LocalTime (..), TimeOfDay (..), ZonedTime (..), fromGregorian, minutesToTimeZone) +import Test.Hspec.Megaparsec (parseSatisfies, shouldFailOn, shouldParse) import Test.Tasty.Hspec (Spec, context, describe, it) import Text.Megaparsec (parse) -import Toml.Parser (arrayP, boolP, doubleP, integerP, keyP, keyValP, tableHeaderP, textP, tomlP) +import Toml.Parser (arrayP, boolP, dateTimeP, doubleP, integerP, keyP, keyValP, tableHeaderP, textP, + tomlP) import Toml.PrefixTree (Key (..), Piece (..), fromList) -import Toml.Type (AnyValue (..), TOML (..), UValue (..), Value (..)) +import Toml.Type (AnyValue (..), DateTime (..), TOML (..), UValue (..), Value (..)) import qualified Data.HashMap.Lazy as HashMap import qualified Data.List.NonEmpty as NE spec_Parser :: Spec spec_Parser = do - let parseX p given expected = parse p "" given `shouldParse` expected - failOn p given = parse p "" `shouldFailOn` given + let parseX p given expected = parse p "" given `shouldParse` expected + failOn p given = parse p "" `shouldFailOn` given + parseXSatisfies p given f = parse p "" given `parseSatisfies` f - parseArray = parseX arrayP - parseBool = parseX boolP - parseDouble = parseX doubleP - parseInteger = parseX integerP - parseKey = parseX keyP - parseKeyVal = parseX keyValP - parseText = parseX textP - parseTable = parseX tableHeaderP - parseToml = parseX tomlP + parseArray = parseX arrayP + parseBool = parseX boolP + parseDateTime = parseX dateTimeP + parseDouble = parseX doubleP + parseInteger = parseX integerP + parseKey = parseX keyP + parseKeyVal = parseX keyValP + parseText = parseX textP + parseTable = parseX tableHeaderP + parseToml = parseX tomlP - arrayFailOn = failOn arrayP - boolFailOn = failOn boolP - keyValFailOn = failOn keyValP - textFailOn = failOn textP + arrayFailOn = failOn arrayP + boolFailOn = failOn boolP + dateTimeFailOn = failOn dateTimeP + doubleFailOn = failOn doubleP + keyValFailOn = failOn keyValP + textFailOn = failOn textP + doubleSatisfies = parseXSatisfies doubleP + quoteWith q t = q <> t <> q squote = quoteWith "'" dquote = quoteWith "\"" + makeDay year month day = Day $ fromGregorian year month day + makeHours hour minute second = Hours $ TimeOfDay hour minute second + makeLocal (Day day) (Hours hours) = Local $ LocalTime day hours + makeLocal _ _ = error "Invalid arguments, unable to construct `Local`" + makeZoned (Local local) offset = Zoned $ ZonedTime local offset + makeZoned _ _ = error "Invalid arguments, unable to construct `Zoned`" + makeOffset hours minutes = minutesToTimeZone (hours * 60 + minutes * (signum hours)) + makeKey k = (Key . NE.fromList) (map Piece k) tomlFromList kv = TOML (HashMap.fromList kv) mempty @@ -51,10 +67,7 @@ parseArray "[1.2, 2.3, 3.4]" [UDouble 1.2, UDouble 2.3, UDouble 3.4] parseArray "['x', 'y']" [UText "x", UText "y"] parseArray "[[1], [2]]" [UArray [UInteger 1], UArray [UInteger 2]] - --xit "can parse arrays of dates" $ do - -- let makeDay y m d = (UDate . Day) (fromGregorian y m d) - -- makeHours h m s = (UDate . Hours) (TimeOfDay h m s) - -- parseArray "[1920-12-10, 10:15:30]" [makeDay 1920 12 10, makeHours 10 15 30] + parseArray "[1920-12-10, 10:15:30]" [UDate (makeDay 1920 12 10), UDate (makeHours 10 15 30)] it "can parse multiline arrays" $ do parseArray "[\n1,\n2\n]" [UInteger 1, UInteger 2] it "can parse an array of arrays" $ do @@ -106,6 +119,19 @@ it "can parse sign-prefixed zero" $ do parseDouble "+0.0" 0.0 parseDouble "-0.0" (-0.0) + it "can parse positive and negative special float values (inf and nan)" $ do + parseDouble "inf" (1 / 0) + parseDouble "+inf" (1 / 0) + parseDouble "-inf" (-1 / 0) + doubleSatisfies "nan" isNaN + doubleSatisfies "+nan" isNaN + doubleSatisfies "-nan" isNaN + it "fails if `inf` or `nan` are not all lowercase" $ do + doubleFailOn "Inf" + doubleFailOn "INF" + doubleFailOn "Nan" + doubleFailOn "NAN" + doubleFailOn "NaN" describe "integerP" $ do context "when the integer is in decimal representation" $ do @@ -207,15 +233,12 @@ describe "keyValP" $ do it "can parse key/value pairs" $ do - parseKeyVal "x='abcdef'" (makeKey ["x"], AnyValue (Text "abcdef")) - parseKeyVal "x=1" (makeKey ["x"], AnyValue (Integer 1)) - parseKeyVal "x=5.2" (makeKey ["x"], AnyValue (Double 5.2)) - parseKeyVal "x=true" (makeKey ["x"], AnyValue (Bool True)) - parseKeyVal "x=[1, 2, 3]" (makeKey ["x"], AnyValue (Array [Integer 1, Integer 2, Integer 3])) - --xit "can parse a key/value pair when the value is a date" $ do - -- let makeDay y m d = (AnyValue .Date . Day) (fromGregorian y m d) - - -- parseKeyVal "x = 1920-12-10" (makeKey ["x"], makeDay 1920 12 10) + parseKeyVal "x='abcdef'" (makeKey ["x"], AnyValue (Text "abcdef")) + parseKeyVal "x=1" (makeKey ["x"], AnyValue (Integer 1)) + parseKeyVal "x=5.2" (makeKey ["x"], AnyValue (Double 5.2)) + parseKeyVal "x=true" (makeKey ["x"], AnyValue (Bool True)) + parseKeyVal "x=[1, 2, 3]" (makeKey ["x"], AnyValue (Array [Integer 1, Integer 2, Integer 3])) + parseKeyVal "x = 1920-12-10" (makeKey ["x"], AnyValue (Date (makeDay 1920 12 10))) --xit "can parse a key/value pair when the value is an inline table" $ do -- pending it "ignores white spaces around key names and values" $ do @@ -241,30 +264,56 @@ textFailOn "\"xyz" textFailOn "xyz\"" textFailOn "xyz" - --xit "can parse escaped quotation marks, backslashes, and control characters" $ do - -- parseString (dquote "backspace: \\b") "backspace: \b" - -- parseString (dquote "tab: \\t") "tab: \t" - -- parseString (dquote "linefeed: \\n") "linefeed: \n" - -- parseString (dquote "form feed: \\f") "form feed: \f" - -- parseString (dquote "carriage return: \\r") "carriage return: \r" - -- parseString (dquote "quote: \\\"") "quote: \"" - -- parseString (dquote "backslash: \\\\") "backslash: \\" - -- parseString (dquote "a\\uD7FFxy\\U0010FFFF\\uE000") "a\55295xy\1114111\57344" - --xit "fails if the string has an unescaped backslash, or control character" $ do - -- stringFailOn (dquote "new \n line") - -- stringFailOn (dquote "back \\ slash") - --xit "fails if the string has an escape sequence that is not listed in the TOML specification" $ do - -- stringFailOn (dquote "xy\\z \\abc") - --xit "fails if the string is not on a single line" $ do - -- stringFailOn (dquote "\nabc") - -- stringFailOn (dquote "ab\r\nc") - -- stringFailOn (dquote "abc\n") - --xit "fails if escape codes are not valid Unicode scalar values" $ do - -- stringFailOn (dquote "\\u1") - -- stringFailOn (dquote "\\uxyzw") - -- stringFailOn (dquote "\\U0000") - -- stringFailOn (dquote "\\uD8FF") - -- stringFailOn (dquote "\\U001FFFFF") + it "can parse escaped quotation marks, backslashes, and control characters" $ do + parseText (dquote "backspace: \\b") "backspace: \b" + parseText (dquote "tab: \\t") "tab: \t" + parseText (dquote "linefeed: \\n") "linefeed: \n" + parseText (dquote "form feed: \\f") "form feed: \f" + parseText (dquote "carriage return: \\r") "carriage return: \r" + parseText (dquote "quote: \\\"") "quote: \"" + parseText (dquote "backslash: \\\\") "backslash: \\" + parseText (dquote "a\\uD7FFxy\\U0010FFFF\\uE000") "a\55295xy\1114111\57344" + it "fails if the string has an unescaped backslash, or control character" $ do + textFailOn (dquote "new \n line") + textFailOn (dquote "back \\ slash") + it "fails if the string has an escape sequence that is not listed in the TOML specification" $ do + textFailOn (dquote "xy\\z \\abc") + it "fails if the string is not on a single line" $ do + textFailOn (dquote "\nabc") + textFailOn (dquote "ab\r\nc") + textFailOn (dquote "abc\n") + it "fails if escape codes are not valid Unicode scalar values" $ do + textFailOn (dquote "\\u1") + textFailOn (dquote "\\uxyzw") + textFailOn (dquote "\\U0000") + textFailOn (dquote "\\uD8FF") + textFailOn (dquote "\\U001FFFFF") + context "when the string is a multi-line basic string" $ do + let dquote3 = quoteWith "\"\"\"" + + it "can parse multi-line strings surrounded by three double quotes" $ do + parseText (dquote3 "Roses are red\nViolets are blue") "Roses are red\nViolets are blue" + it "can parse single-line strings surrounded by three double quotes" $ do + parseText (dquote3 "Roses are red Violets are blue") "Roses are red Violets are blue" + it "can parse all of the escape sequences that are valid for basic strings" $ do + parseText (dquote3 "backspace: \\b") "backspace: \b" + parseText (dquote3 "tab: \\t") "tab: \t" + parseText (dquote3 "linefeed: \\n") "linefeed: \n" + parseText (dquote3 "form feed: \\f") "form feed: \f" + parseText (dquote3 "carriage return: \\r") "carriage return: \r" + parseText (dquote3 "quote: \\\"") "quote: \"" + parseText (dquote3 "backslash: \\\\") "backslash: \\" + parseText (dquote3 "a\\uD7FFxy\\U0010FFFF\\uE000") "a\55295xy\1114111\57344" + it "does not ignore whitespaces or newlines" $ do + parseText (dquote3 "\nabc \n xyz") "abc \n xyz" + it "ignores a newline only if it immediately follows the opening delimiter" $ do + parseText (dquote3 "\nThe quick brown") "The quick brown" + it "ignores whitespaces and newlines after line ending backslash" $ do + parseText (dquote3 "The quick brown \\\n\n fox jumps over") "The quick brown fox jumps over" + it "fails if the string has an unescaped backslash, or control character" $ do + textFailOn (dquote3 "backslash \\ .") + textFailOn (dquote3 "backspace \b ..") + textFailOn (dquote3 "tab \t ..") context "when the string is a literal string" $ do it "can parse strings surrounded by single quotes" $ do parseText (squote "C:\\Users\\nodejs\\templates") "C:\\Users\\nodejs\\templates" @@ -272,10 +321,63 @@ parseText (squote "Tom \"Dubs\" Preston-Werner") "Tom \"Dubs\" Preston-Werner" parseText (squote "<\\i\\c*\\s*>") "<\\i\\c*\\s*>" parseText (squote "a \t tab") "a \t tab" - --xit "fails if the string is not on a single line" $ do - -- stringFailOn (squote "\nabc") - -- stringFailOn (squote "ab\r\nc") - -- stringFailOn (squote "abc\n") + it "fails if the string is not on a single line" $ do + textFailOn (squote "\nabc") + textFailOn (squote "ab\r\nc") + textFailOn (squote "abc\n") + context "when the string is a multi-line literal string" $ do + let squote3 = quoteWith "'''" + + it "can parse multi-line strings surrounded by three single quotes" $ do + parseText (squote3 "first line \nsecond.\n 3\n") "first line \nsecond.\n 3\n" + it "can parse single-line strings surrounded by three single quotes" $ do + parseText (squote3 "I [dw]on't need \\d{2} apples") "I [dw]on't need \\d{2} apples" + it "ignores a newline immediately following the opening delimiter" $ do + parseText (squote3 "\na newline \nsecond.\n 3\n") "a newline \nsecond.\n 3\n" + it "fails if the string has an unescaped control character other than tab" $ do + parseText (squote3 "\t") "\t" + textFailOn (squote3 "\b") + + describe "dateTimeP" $ do + it "can parse a date-time with an offset" $ do + parseDateTime "1979-05-27T07:32:00Z" (makeZoned (makeLocal (makeDay 1979 5 27) (makeHours 7 32 0)) (makeOffset 0 0)) + parseDateTime "1979-05-27T00:32:00+07:10" (makeZoned (makeLocal (makeDay 1979 5 27) (makeHours 0 32 0)) (makeOffset 7 10)) + parseDateTime "1979-05-27T00:32:00.999999-07:25" (makeZoned (makeLocal (makeDay 1979 5 27) (makeHours 0 32 0.999999)) (makeOffset (-7) 25)) + it "can parse a date-time with an offset when the T delimiter is replaced with a space" $ do + parseDateTime "1979-05-27 07:32:00Z" (makeZoned (makeLocal (makeDay 1979 5 27) (makeHours 7 32 0)) (makeOffset 0 0)) + it "can parse a date-time without an offset" $ do + parseDateTime "1979-05-27T17:32:00" (makeLocal (makeDay 1979 5 27) (makeHours 17 32 0)) + parseDateTime "1979-05-27T00:32:00.999999" (makeLocal (makeDay 1979 5 27) (makeHours 0 32 0.999999)) + it "can parse a local date" $ do + parseDateTime "1979-05-27" (makeDay 1979 5 27) + it "can parse a local time" $ do + parseDateTime "07:32:00" (makeHours 7 32 0) + parseDateTime "00:32:00.999999" (makeHours 0 32 0.999999) + it "truncates the additional precision after picoseconds in the fractional seconds" $ do + parseDateTime "00:32:00.99999999999199" (makeHours 0 32 0.999999999991) + it "fails if the date is not valid" $ do + dateTimeFailOn "1920-15-12" + dateTimeFailOn "1920-12-40" + it "fails if the date does not have the form: 'yyyy-mm-dd'" $ do + dateTimeFailOn "1920-01-1" + dateTimeFailOn "1920-1-01" + dateTimeFailOn "920-01-01" + dateTimeFailOn "1920/10/01" + it "fails if the time is not valid" $ do + dateTimeFailOn "25:10:10" + dateTimeFailOn "10:70:10" + dateTimeFailOn "10:10:70" + it "fails if the time does not have the form: 'hh:mm:ss'" $ do + dateTimeFailOn "1:12:12" + dateTimeFailOn "12:1:12" + dateTimeFailOn "12:12:1" + dateTimeFailOn "12-12-12" + it "fails if the offset does not have any of the forms: 'Z', '+hh:mm', '-hh:mm'" $ do + parseDateTime "1979-05-27T00:32:00X" (makeLocal (makeDay 1979 5 27) (makeHours 0 32 0)) + parseDateTime "1979-05-27T00:32:00+07:1" (makeLocal (makeDay 1979 5 27) (makeHours 0 32 0)) + parseDateTime "1979-05-27T00:32:00+7:01" (makeLocal (makeDay 1979 5 27) (makeHours 0 32 0)) + parseDateTime "1979-05-27T00:32:0007:00" (makeLocal (makeDay 1979 5 27) (makeHours 0 32 0)) + describe "tableHeaderP" $ do it "can parse a TOML table" $ do diff --git a/tomland.cabal b/tomland.cabal --- a/tomland.cabal +++ b/tomland.cabal @@ -1,5 +1,5 @@ name: tomland -version: 0.3 +version: 0.3.1 synopsis: TOML parser description: See README.md for details. homepage: https://github.com/kowainik/tomland @@ -14,7 +14,8 @@ extra-doc-files: README.md , CHANGELOG.md cabal-version: 1.24 -tested-with: GHC == 8.2.2 +tested-with: GHC == 8.4.3 + , GHC == 8.2.2 , GHC == 8.0.2 library @@ -43,6 +44,7 @@ , parser-combinators , text , time + , transformers >= 0.5 , unordered-containers ghc-options: -Wall