git-config (empty) → 0.1.0

raw patch · 7 files changed

+483/−0 lines, 7 filesdep +basedep +git-configdep +megaparsecsetup-changed

Dependencies added: base, git-config, megaparsec, smallcheck, smallcheck-series, tasty, tasty-discover, tasty-hunit, tasty-smallcheck, tasty-travis, text, unordered-containers

Files

• LICENSE +28/−0
• README.md +55/−0
• Setup.hs +2/−0
• git-config.cabal +83/−0
• src/Text/GitConfig/Parser.hs +173/−0
• test/Tasty.hs +1/−0
• test/Text/GitConfig/ParserTest.hs +141/−0

@@ -0,0 +1,28 @@+Copyright (c) 2018 Fernando Freire, 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 Author name here 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.

@@ -0,0 +1,55 @@+[![Build Status](https://travis-ci.org/dogonthehorizon/git-config.svg?branch=master)](https://travis-ci.org/dogonthehorizon/git-config)++# git-config++A simple parser for [Git configuration] files.++## Getting Started++This project is built using [Stack], make sure you have it installed before+proceeding.++You can fire up an interactive session like so:++```+stack ghci+```++The library can be built or tested like so:++```+# Building+stack build+# Running tests+stack test+```++## Usage++A Git configuration is a colletion of sections that contain mappings of keys+to values.++For the sake of simplicity this is represented as `[Section]` where a+`Section` is a collection of section names and a mapping of keys to values.++We can use the parser like so:++```haskell+import qualified Data.Text.IO as TIO+import Text.GitConfig.Parser (parseConfig)++main :: IO ()+main = do+  file <- TIO.readFile ".git/config"+  case parseConfig file of+    Right conf ->+      print conf+    Left error ->+      print error+```++If you'd like to do your own parsing you can import the individual combinators+from the `Text.GitConfig.Parser` module.++[Stack]: https://docs.haskellstack.org/en/stable/README/+[Git configuration]: https://git-scm.com/docs/git-config/2.16.0#_syntax

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,83 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 61a8d8d4516720b4def60b163c2a76d8e819827aa17f1edbe115b50258866169++name:           git-config+version:        0.1.0+synopsis:       A simple parser for Git configuration files.+description:    git-config is a simple 'megaparsec' parser for Git configuration files.+                .+                It aims to provide the simplest API possible for parsing Git configuration+                files so that you can get to whatever it was you were doing.+                .+                A sample of this library in use:+                .+                > import qualified Data.Text.IO as TIO+                > import Text.GitConfig.Parser (parseConfig)+                >+                > main :: IO ()+                > main = do+                >   file <- TIO.readFile ".git/config"+                >   case parseConfig file of+                >     Right conf ->+                >       print conf+category:       Library,Git+homepage:       https://github.com/dogonthehorizon/git-config#readme+bug-reports:    https://github.com/dogonthehorizon/git-config/issues+author:         Fernando Freire+maintainer:     dogonthehorizon@gmail.com+copyright:      2018 Fernando Freire+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/dogonthehorizon/git-config++library+  hs-source-dirs:+      src+  default-extensions: OverloadedStrings+  ghc-options: -Wall -fno-warn-partial-type-signatures -fno-warn-name-shadowing -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-incomplete-patterns+  build-depends:+      base >=4.7 && <5+    , megaparsec+    , text+    , unordered-containers+  exposed-modules:+      Text.GitConfig.Parser+  other-modules:+      Paths_git_config+  default-language: Haskell2010++test-suite git-config-test+  type: exitcode-stdio-1.0+  main-is: Tasty.hs+  hs-source-dirs:+      test+  default-extensions: OverloadedStrings+  ghc-options: -Wall -fno-warn-partial-type-signatures -fno-warn-name-shadowing -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , git-config+    , megaparsec+    , smallcheck+    , smallcheck-series+    , tasty+    , tasty-discover+    , tasty-hunit+    , tasty-smallcheck+    , tasty-travis+    , text+    , unordered-containers+  other-modules:+      Text.GitConfig.ParserTest+      Paths_git_config+  default-language: Haskell2010

@@ -0,0 +1,173 @@+{-|+Module      : Text.GitConfig.Parser+Description : Parser-combinators for Git configuration files.+Copyright   : (c) Fernando Freire, 2018+License     : BSD3+Maintainer  : dogonthehorizon@gmail.com+Stability   : experimental++This module provides parser-combinators for Git configuration files.++It attempts to follow the syntax for Git configuration files outlined in+this document:++https://git-scm.com/docs/git-config/2.16.0#_syntax++One notable omission is that no legacy compatability is explicitly provided+(e.g. dot-separated subsection names are not guaranteed to parse correctly).+-}++{-# LANGUAGE TypeFamilies #-}++module Text.GitConfig.Parser (+  -- * Types+  Parser,+  Section(..),+  GitConfig,+  -- * Lexer+  spaceConsumer,+  lexeme,+  symbol,+  brackets,+  quotes,+  escSeq,+  -- * Parser+  sectionName,+  sectionHeader,+  variableName,+  variableValue,+  mapping,+  section,+  config,+  parseConfig+) where++import           Control.Applicative        (empty)+import           Control.Monad              (void)+import           Data.Functor               (($>))+import           Data.HashMap.Strict        (HashMap)+import qualified Data.HashMap.Strict        as M+import           Data.Text                  (Text)+import qualified Data.Text                  as T+import           Data.Void                  (Void)+import           Text.Megaparsec            (ParseError, Parsec, Token, between,+                                             eof, many, parse, sepBy, some,+                                             (<?>), (<|>))+import           Text.Megaparsec.Char       (alphaNumChar, char, eol,+                                             letterChar, printChar, satisfy,+                                             space1)+import qualified Text.Megaparsec.Char.Lexer as Lexer++type GitConfigError = ParseError (Token Text) Void+type Parser = Parsec Void Text++data Section = Section [Text] (HashMap Text Text)+  deriving (Eq, Show)++type GitConfig = [Section]++-- | Whitespace consumer for this parser.+--+-- Whitespace is considered to be any space character+-- (including carriage return) as well as line comments starting with `#` and+-- `;` .+spaceConsumer :: Parser ()+spaceConsumer = Lexer.space space1 lineComment empty+  where lineComment = Lexer.skipLineComment "#" <|> Lexer.skipLineComment ";"++-- | A lexeme for this parser.+lexeme :: Parser a -> Parser a+lexeme = Lexer.lexeme spaceConsumer++-- | A symbol for this parser.+symbol :: Text -> Parser Text+symbol = Lexer.symbol spaceConsumer++-- | Return a parser in between brackets.+brackets :: Parser a -> Parser a+brackets = between (symbol "[") (symbol "]")++-- | Return a parser in between quotes.+quotes :: Parser a -> Parser a+quotes = between (symbol "\"") (symbol "\"")++-- | Parser for escape sequences.+escSeq :: Parser Char+escSeq = char '\\' *> escSeqChar+  where+    escSeqChar =  char '"'+              <|> char '\\'+              <|> char '/'+              <|> (char 'n' $> '\n')+              <|> (char 't' $> '\t')+              <|> (char 'r' $> '\r')+              <|> (char 'b' $> '\b')+              <|> (char 'f' $> '\f')+              <?> "escaped character"++-- | Parse a section name.+--+-- Section names are case-insensitive. Only alphanumeric+-- characters, - and . are allowed in section names. Sections can be further+-- divided into subsections. To begin a subsection put its name in double+-- quotes, separated by space from the section name, in the section header.+sectionName :: Parser [Text]+sectionName = (section <|> subSection) `sepBy` spaceConsumer+  where+    sectionChar = alphaNumChar <|> char '.' <|> char '-'+    section     = fmap T.pack . some $ sectionChar+    subSection  = fmap T.pack . quotes . many $+      escSeq <|> satisfy (\x -> x `notElem` ['"', '\\'])++-- | Parse a section header.+--+-- A section begins with the name of the section in square brackets and+-- continues until the next section begins.+sectionHeader :: Parser [Text]+sectionHeader = brackets sectionName++-- | Parse a variable name.+--+--  The variable names are case-insensitive, allow only alphanumeric+--  characters and -, and must start with an alphabetic character.+variableName :: Parser Text+variableName = fmap (T.toLower . T.pack) . lexeme $ p+  where+    p = (:) <$> letterChar <*> many (alphaNumChar <|> char '-')++-- | Parse a variable value.+variableValue :: Parser Text+variableValue = T.pack <$> between spaceConsumer eol (many printChar)++-- | Parse a tuple of 'Text' key and value.+--+--  in the form name = value (or just name, which is a short-hand to say that+--  the variable is the boolean "true"). -- FIXME parse boolean true+--+--  A line that defines a value can be continued to the next line by ending+--  it with a \; the backquote and the end-of-line are stripped. Leading+--  whitespaces after name =, the remainder of the line after the first+--  comment character # or ;, and trailing whitespaces of the line are+--  discarded unless they are enclosed in double quotes. Internal whitespaces+--  within the value are retained verbatim.+mapping :: Parser (Text, Text)+mapping = do+  varName <- variableName+  void (symbol "=")+  varValue <- variableValue+  return (varName, varValue)++-- | Parse a complete git config section.+section :: Parser Section+section = do+  header <- sectionHeader+  void spaceConsumer+  sectionValues <- mapping `sepBy` spaceConsumer+  return $ Section header (M.fromList sectionValues)++-- | Parse a complete git config.+config :: Parser GitConfig+config = between spaceConsumer eof $ many section++parseConfig :: Text -> Either GitConfigError GitConfig+parseConfig = parse config "noSrc"

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}

@@ -0,0 +1,141 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Text.GitConfig.ParserTest where++import qualified Data.HashMap.Strict              as M+import           Data.Monoid                      ((<>))+import           Data.Text                        (Text)+import qualified Data.Text                        as T+import           Test.SmallCheck.Series.Instances ()+import           Test.Tasty                       (TestTree, testGroup)+import           Test.Tasty.HUnit                 (Assertion, assertEqual,+                                                   assertFailure, testCase)+import           Test.Tasty.SmallCheck            (testProperty)+import qualified Text.GitConfig.Parser            as P+import           Text.Megaparsec                  (parse)++-- | Simple assert helper for HUnit tests on parse results+assertSuccess :: Either e a -> Assertion+assertSuccess res =+  case res of+    Left _ -> assertFailure ""+    Right _ -> return ()++assertFail :: Either e a -> Assertion+assertFail res =+  case res of+    Left _ -> return ()+    Right _ -> assertFailure ""++test_symbol :: TestTree+test_symbol = testProperty+  "symbol should parse the given text and consume trailing whitespace" $+    \(t :: Text) ->+      case parse (P.symbol t) "" (t <> "  ") of+        Left _ -> False+        Right t' -> t == t'++test_brackets :: TestTree+test_brackets = testProperty+  "brackets should parse the given text between '[' and ']' characters" $+    \(t :: Text) ->+      let tBetweenBrackets = "[" <> t <> "]" in+      case parse (P.brackets (P.symbol t)) "" tBetweenBrackets of+        Left _ -> False+        Right t' -> t == t'++test_quotes :: TestTree+test_quotes = testProperty+  "quotes should parse the given text between '\"' characters" $+    \(t :: Text) ->+      let tBetweenQuotes = "\"" <> t <> "\"" in+        case parse (P.quotes (P.symbol t)) "" tBetweenQuotes of+          Left _ -> False+          Right t' -> t == t'++(<&>) :: Functor f => f a -> (a -> b) -> f b+(<&>) = flip fmap++test_escSeq :: TestTree+test_escSeq = testGroup "ensure all valid escape sequences are parsed" $+  ["\"", "\\", "/", "n", "t", "r", "b", "f"] <&> \(t :: Text) ->+    let escaped = "\\" <> t in+    testCase (T.unpack $ "char " <> escaped) $+      assertSuccess $ parse P.escSeq "" escaped++test_sectionName :: TestTree+test_sectionName = testGroup+  "sectionName parses both section and subsection names"+    [+      testCase "section" $+        assertSuccess $ parse P.sectionName "" "core",+      testCase "subSection" $+        assertSuccess $ parse P.sectionName "" "core \"sub/+Section\""+    ]++test_sectionHeader :: TestTree+test_sectionHeader = testGroup+  "sectionHeader parses an entire section header"+    [+      testCase "section" $+        assertSuccess $ parse P.sectionHeader "" "[core]",+      testCase "subSection" $+        assertSuccess $ parse P.sectionHeader "" "[core \"sub/+Section\"]"+    ]++test_variableName :: TestTree+test_variableName = testGroup "variableName parses a key in a key/val pair"+  [+    testCase "valid" $+      assertSuccess $ parse P.variableName "" "aSdF",+    testCase "fail start with nonalpha" $+      assertFail $ parse P.variableName "" "+ASDF",+    testCase "pass with dash" $+      assertSuccess $ parse P.variableName "" "foo-bar"+  ]++test_variableValue :: TestTree+test_variableValue = testGroup+  "variableValue parses the value in a key/value pair"+    [+      testCase "valid" $+        assertSuccess $ parse P.variableValue "" "foo\n",+      testCase "fail without eol" $+        assertFail $ parse P.variableValue "" "foo"+    ]++test_mapping :: TestTree+test_mapping = testGroup+  "mapping parses entire key/value pairs"+    [+      testCase "valid" $+        assertSuccess $ parse P.mapping "" "key = value\n",+      testCase "temporarily invalid boolean switch" $+        assertFail $ parse P.mapping "" "key\n"+    ]++test_section :: TestTree+test_section = testGroup+  "section parses entire sections in a git config"+    [+      testCase "valid" $+        assertSuccess $ parse P.section "" "[core]\nfoo = bar\n",+      testCase "valid multiple mappings" $+        assertSuccess $ parse P.section "" "[core]\nfoo = bar\nbaz = quux\n",+      testCase "valid stop at one section" $+        case parse P.section "" "[core \"subsec\"]\nfoo = bar\n[next \"section\"]\nlol = hi\n" of+          Left _ -> assertFailure ""+          Right p ->+            assertEqual ""+              (P.Section ["core", "subsec"] (M.fromList [("foo", "bar")])) p+    ]++test_config :: TestTree+test_config = testGroup+  "config parses an entire git configuration"+  [+    testCase "valid" $+      assertSuccess $ parse P.config "" "[core]\nfoo=bar\n[remote \"origin\"]\nkey=val\n",+    testCase "invalid mapping without section" $+      assertFail $ parse P.config "" "foo=bar\n[remote \"origin\"]\nkey=val\n"+  ]