tomland 0.3 → 0.3.1
raw patch · 9 files changed
+412/−90 lines, 9 filesdep +transformerssetup-changed
Dependencies added: transformers
Files
- CHANGELOG.md +14/−0
- Setup.hs +0/−2
- examples/Playground.hs +4/−0
- src/Toml/Bi/Code.hs +46/−6
- src/Toml/Bi/Combinators.hs +8/−1
- src/Toml/Bi/Monad.hs +22/−0
- src/Toml/Parser.hs +153/−20
- test/Test/Toml/Parsing/Unit.hs +161/−59
- tomland.cabal +4/−2
CHANGELOG.md view
@@ -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 =====
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
examples/Playground.hs view
@@ -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
src/Toml/Bi/Code.hs view
@@ -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
src/Toml/Bi/Combinators.hs view
@@ -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)
src/Toml/Bi/Monad.hs view
@@ -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
src/Toml/Parser.hs view
@@ -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
test/Test/Toml/Parsing/Unit.hs view
@@ -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
tomland.cabal view
@@ -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