diff --git a/connection-string.cabal b/connection-string.cabal --- a/connection-string.cabal +++ b/connection-string.cabal @@ -1,47 +1,48 @@ -name: connection-string -version: 0.1.0.0 -synopsis: A library for parsing connection strings. -description: - Parses connection strings in a manner that agrees with - the format that .NET accepts (e.g. ADO.NET). -homepage: https://github.com/Porges/connection-string -license: BSD3 -license-file: LICENSE -author: George Pollard -maintainer: George Pollard -copyright: 2018 George Pollard -category: Text -build-type: Simple -cabal-version: >=1.10 -extra-source-files: README.md - -source-repository head - type: git - location: git://github.com/Porges/connection-string-hs.git - -source-repository this - type: git - location: git://github.com/Porges/connection-string-hs.git - tag: v0.1.0.0 - -library - exposed-modules: Data.ConnectionString - hs-source-dirs: src - ghc-options: -Wall - default-language: Haskell2010 - build-depends: base >= 4.7 && < 5 - , containers - , megaparsec - , parser-combinators - -test-suite doctests - type: exitcode-stdio-1.0 - ghc-options: -threaded - default-language: Haskell2010 - hs-source-dirs: tests - main-is: doctests.hs - build-depends: - base >= 4 && < 5, - doctest >= 0.8 && < 0.15, - text - +name: connection-string +version: 0.2.0.0 +synopsis: A library for parsing connection strings. +description: + Parses connection strings in a manner that agrees with + the format that .NET accepts (e.g. ADO.NET). +homepage: https://github.com/Porges/connection-string-hs +license: BSD3 +license-file: LICENSE +author: George Pollard +maintainer: George Pollard +copyright: 2018 George Pollard +category: Text +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +source-repository head + type: git + location: git://github.com/Porges/connection-string-hs.git + +source-repository this + type: git + location: git://github.com/Porges/connection-string-hs.git + tag: v0.2.0.0 + +library + exposed-modules: Data.ConnectionString + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , case-insensitive + , containers + , megaparsec + , parser-combinators + +test-suite doctests + type: exitcode-stdio-1.0 + ghc-options: -threaded + default-language: Haskell2010 + hs-source-dirs: tests + main-is: doctests.hs + build-depends: + base >= 4 && < 5, + doctest >= 0.8 && < 0.15, + text + diff --git a/src/Data/ConnectionString.hs b/src/Data/ConnectionString.hs --- a/src/Data/ConnectionString.hs +++ b/src/Data/ConnectionString.hs @@ -1,5 +1,8 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} {-| Module: Data.ConnectionString @@ -13,8 +16,8 @@ The syntax of a connection string appears quite simple at first glance, and consists of a list of key-value pairs separated by semicolons: ->>> parse "key=value; key2 = value2" -Right (fromList [("key","value"),("key2","value2")]) +>>> toList <$> parse "key=value; key2 = value2" +Right [("key","value"),("key2","value2")] However, the format can be more complicated than expected. @@ -23,45 +26,57 @@ A value may be single-quoted (single quotes can be escaped inside a single-quoted string by doubling them): ->>> parse "squote='value with '' quotes'" -Right (fromList [("squote","value with ' quotes")]) +>>> toList <$> parse "squote='value with '' quotes'" +Right [("squote","value with ' quotes")] Or double-quoted (double quotes can also be escaped inside a double-quoted string by doubling them): ->>> parse "dquote=\"value with \"\" quotes\"" -Right (fromList [("dquote","value with \" quotes")]) +>>> let (Right quoted) = parse "dquote=\"value with \"\" quotes\"" +>>> toList quoted +[("dquote","value with \" quotes")] +>>> quoted +"dquote='value with \" quotes'" +-- ^ TODO: Note that this is for exact compatibility + Quotes of both kinds may be present in keys: ->>> parse "'quote\"=value" -Right (fromList [("'quote\"","value")]) +>>> toList <$> parse "'quote\"=value" +Right [("'quote\"","value")] Whitespace is ignored everywhere except in quoted strings and inside keys or unquoted values: ->>> parse "; a key = v v\t\n;\t key 2 = \"v v\"\n;\t key 3 = 'v v'; " -Right (fromList [("a key","v v"),("key 2","v v"),("key 3","v v")]) +>>> toList <$> parse "; a key = v v\t\n;\t key 2 = \"v v\"\n;\t key 3 = 'v v'; " +Right [("a key","v v"),("key 2","v v"),("key 3","v v")] Equals signs may be escaped in keys by doubling them: ->>> parse "1==2=false" -Right (fromList [("1=2","false")]) +>>> toList <$> parse "1==2=false" +Right [("1=2","false")] +Keys are case-insensitive (and converted to lower-case on output): + +>>> toList <$> parse "BIG=small" +Right [("big","small")] + Later values override earlier ones: ->>> parse "key=value;key=value2" -Right (fromList [("key","value2")]) +>>> toList <$> parse "key=value;key=value2" +Right [("key","value2")] Assigning a key no value will remove it: ->>> parse "key=value;key=" -Right (fromList []) +>>> toList <$> parse "key=value;key=" +Right [] However, you can assign an empty value by giving it a quoted value: ->>> parse "key=value;key=''" -Right (fromList [("key","")]) +>>> toList <$> parse "key=value;key=''" +Right [("key","")] +-- TODO ^ there appears to be a bug here in .NET + On the other hand, not providing a key doesn't make any sense: >>> parse "key=value;=value" @@ -70,11 +85,21 @@ >>> parse "=value" Left "1:1:\nunexpected '='\nexpecting ';', end of input, or white space\n" +Another quirk is that keys can contain semicolons: + +>>> toList <$> parse "key=value;key2;extended=value" +Right [("key","value"),("key2;extended","value")] + This module implements all of these quirks for you! -} module Data.ConnectionString ( ConnectionString + , toList + , keys + , values + , (!) + , toString , parse , Parseable , parser @@ -82,10 +107,15 @@ where import Data.Char (isSpace) -import Data.List (dropWhileEnd) -import qualified Data.Map as Map +import qualified Data.CaseInsensitive as CI +import Data.Function ((&)) +import Data.List (dropWhileEnd, intersperse) +import qualified Data.Map.Strict as Map +import Data.Monoid ((<>)) import Data.String (IsString(..)) import Data.Void (Void) +import qualified GHC.Exts as Exts +import GHC.Exts (IsList(Item)) import Control.Applicative.Combinators (many, sepEndBy, skipMany, skipSome, some, (<|>)) @@ -93,22 +123,93 @@ import Text.Megaparsec (Parsec, try, Stream, Token, ()) import Text.Megaparsec.Char (char, notChar, space) --- | A connection string is a set of keys and values. -type ConnectionString s = Map.Map s s +-- | A connection string is a set of keys that map to values. +newtype ConnectionString s = ConnectionString (Map.Map (Key s) s) + deriving (Eq) +instance (Show s, IsString s, IsList s, Item s ~ Char) => Show (ConnectionString s) where + show = show . toString + +toList :: ConnectionString s -> [(s, s)] +toList (ConnectionString cs) = + Map.toList cs + & map (\(Key k, v) -> (CI.foldedCase k, v)) + +keys :: ConnectionString s -> [s] +keys (ConnectionString cs) = + Map.keys cs + & map (\(Key k) -> CI.foldedCase k) + +values :: ConnectionString s -> [s] +values (ConnectionString cs) = Map.elems cs + +-- | Tries to find the given key in the connection string, +-- and returns either the value or 'Nothing'. +(!) :: (CI.FoldCase s, Ord s, IsList s, Item s ~ Char) => ConnectionString s -> s -> Maybe s +ConnectionString cs ! key = cs Map.!? toKey key + +-- | A key is case-insensitive and does not start +-- or end with whitespace characters. +newtype Key s = Key (CI.CI s) + deriving (Eq, Ord) + +-- | Converts the given string-like type to a key. (Does not fail.) +toKey :: (CI.FoldCase s, IsList s, Item s ~ Char) => s -> Key s +toKey s = + Exts.toList s + & dropWhile isSpace + & dropWhileEnd isSpace + & Exts.fromList + & CI.mk + & Key + +-- | Render a 'ConnectionString' as the string type. +toString :: forall s. (IsString s, IsList s, Item s ~ Char) => ConnectionString s -> s +toString (ConnectionString cs) = + Map.toList cs + & map (\(k, v) -> encodeKey k <> "=" <> encodeValue v) + & intersperse ";" + & mconcat + & Exts.fromList + + where + encodeKey :: Key s -> String + encodeKey (Key (CI.foldedCase -> k)) = + replace '=' "==" (Exts.toList k) + + encodeValue :: s -> String + encodeValue (Exts.toList -> v) + | v == "" = "''" + | hasDquote && not hasSquote = "'" <> v <> "'" + | hasSemiColon || hasSpace || hasDquote || hasSquote + = "\"" <> replace '"' "\"\"" v <> "\"" + | otherwise = v + where + hasSquote = '\'' `elem` v + hasDquote = '"' `elem` v + hasSemiColon = ';' `elem` v + hasSpace = any isSpace v + + replace :: Char -> String -> String -> String + replace _ _ [] = [] + replace from to (x:xs) + | from == x = to ++ replace from to xs + | otherwise = x : replace from to xs + + -- | Parses a connection string, or fails with an error. -- -- You can parse 'String' inputs: -- -- >>> parse ("key=value;key2=value2") --- Right (fromList [("key","value"),("key2","value2")]) +-- Right "key=value;key2=value2" -- -- Or you can parse 'Data.Text.Text' inputs: -- -- >>> :set -XOverloadedStrings -- >>> import Data.Text -- >>> parse ("key=value;key2=value2" :: Text) --- Right (fromList [("key","value"),("key2","value2")]) +-- Right "key=value;key2=value2" -- -- In either case, 'parse' will produce a 'ConnectionString' that -- has values of the same type as the input. @@ -116,28 +217,28 @@ parse cs = case (P.parse (parser <* P.eof) "" cs) of Left err -> Left (P.parseErrorPretty err) - Right kvs -> Right (Map.mapMaybe id (Map.fromList kvs)) + Right kvs -> Right (ConnectionString (Map.mapMaybe id (Map.fromList kvs))) -- | The constraints on things that 'parse' can handle. -- (Essentially this means "either 'String' or 'Data.Text.Text'".) -type Parseable s = (Stream s, Token s ~ Char, IsString s, Ord s) +type Parseable s = (Stream s, Token s ~ Char, IsString s, Ord s, CI.FoldCase s) -- | A reusable ("Text.Megaparsec") parser for connection strings. -- -- A 'Nothing' in the output list indicates that the corresponding -- key should be deleted from the set. -parser :: Parseable s => Parsec Void s [(s, Maybe s)] +parser :: Parseable s => Parsec Void s [(Key s, Maybe s)] parser = skipMany semiColon *> keyValue `sepEndBy` (skipSome semiColon) where semiColon = P.between space space (char ';') -keyValue :: Parseable s => Parsec Void s (s, Maybe s) +keyValue :: Parseable s => Parsec Void s (Key s, Maybe s) keyValue = (,) <$> (key "key") <* equals <*> (value "value") where equals = P.between space space (char '=') key = - fromString . dropWhileEnd isSpace <$> + Key . CI.mk . fromString . dropWhileEnd isSpace <$> some (notChar '=' <|> try (char '=' *> char '=')) value = fmap fromString <$> (sQuoted <|> dQuoted <|> unQuoted)