diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright George Pollard (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of George Pollard nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,7 @@ +# connection-string + +Easy connection string parsing for Haskell. + +[![Travis build](https://img.shields.io/travis/Porges/connection-string-hs.svg)](https://travis-ci.org/Porges/connection-string-hs) [![Hackage](https://img.shields.io/hackage/v/connection-string.svg)](https://hackage.haskell.org/package/connection-string) + +[See the documentation on Hackage.](https://hackage.haskell.org/package/connection-string) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/connection-string.cabal b/connection-string.cabal new file mode 100644 --- /dev/null +++ b/connection-string.cabal @@ -0,0 +1,47 @@ +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 + diff --git a/src/Data/ConnectionString.hs b/src/Data/ConnectionString.hs new file mode 100644 --- /dev/null +++ b/src/Data/ConnectionString.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} + +{-| +Module: Data.ConnectionString + +== Introduction + +This module is intended for parsing connection strings in a manner +that is consistent with .NET's +class. + +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")]) + +However, the format can be more complicated than expected. + +== Examples + +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")]) + +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")]) + +Quotes of both kinds may be present in keys: + +>>> parse "'quote\"=value" +Right (fromList [("'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")]) + +Equals signs may be escaped in keys by doubling them: + +>>> parse "1==2=false" +Right (fromList [("1=2","false")]) + +Later values override earlier ones: + +>>> parse "key=value;key=value2" +Right (fromList [("key","value2")]) + +Assigning a key no value will remove it: + +>>> parse "key=value;key=" +Right (fromList []) + +However, you can assign an empty value by giving it a quoted value: + +>>> parse "key=value;key=''" +Right (fromList [("key","")]) + +On the other hand, not providing a key doesn't make any sense: + +>>> parse "key=value;=value" +Left "1:11:\nunexpected '='\nexpecting ';', end of input, or white space\n" + +>>> parse "=value" +Left "1:1:\nunexpected '='\nexpecting ';', end of input, or white space\n" + +This module implements all of these quirks for you! + +-} +module Data.ConnectionString + ( ConnectionString + , parse + , Parseable + , parser + ) +where + +import Data.Char (isSpace) +import Data.List (dropWhileEnd) +import qualified Data.Map as Map +import Data.String (IsString(..)) +import Data.Void (Void) + +import Control.Applicative.Combinators (many, sepEndBy, skipMany, skipSome, some, (<|>)) + +import qualified Text.Megaparsec as P +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 + +-- | 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")]) +-- +-- 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")]) +-- +-- In either case, 'parse' will produce a 'ConnectionString' that +-- has values of the same type as the input. +parse :: Parseable s => s -> Either String (ConnectionString s) +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)) + +-- | 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) + +-- | 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 = skipMany semiColon *> keyValue `sepEndBy` (skipSome semiColon) + where + semiColon = P.between space space (char ';') + +keyValue :: Parseable s => Parsec Void s (s, Maybe s) +keyValue = (,) <$> (key "key") <* equals <*> (value "value") + where + equals = P.between space space (char '=') + + key = + fromString . dropWhileEnd isSpace <$> + some (notChar '=' <|> try (char '=' *> char '=')) + + value = fmap fromString <$> (sQuoted <|> dQuoted <|> unQuoted) + + sQuoted = + Just <$> + P.between (char '\'') (char '\'') (many (notChar '\'' <|> try (char '\'' *> char '\''))) + + dQuoted = + Just <$> + P.between (char '"') (char '"') (many (notChar '"' <|> try (char '"' *> char '"'))) + + unQuoted = + -- a completely empty value indicates we should remove it (see docs + -- above), so we return Nothing in this case + (\s -> if null s then Nothing else Just s) . dropWhileEnd isSpace <$> + (space *> many (notChar ';') <* space) + diff --git a/tests/doctests.hs b/tests/doctests.hs new file mode 100644 --- /dev/null +++ b/tests/doctests.hs @@ -0,0 +1,6 @@ +import Test.DocTest + +main = doctest + [ "-isrc" + , "src/Data/ConnectionString.hs" + ]