packages feed

language-hcl (empty) → 0.1.1.0

raw patch · 55 files changed

+1023/−0 lines, 55 filesdep +QuickCheckdep +basedep +criterionsetup-changed

Dependencies added: QuickCheck, base, criterion, deepseq, directory, filepath, hspec, hspec-megaparsec, language-hcl, megaparsec, pretty, scientific, semigroups, text, transformers, unordered-containers

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 Pedro Tacla Yamada++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/HCLBenchmark.hs view
@@ -0,0 +1,27 @@+import           Control.Arrow    ((>>>))+import           Control.Monad+import           Criterion.Main+import           Data.HCL+import qualified Data.Text.IO     as Text (readFile)+import           System.Directory (getDirectoryContents)+import           System.FilePath  (takeExtension, (</>))++main :: IO ()+main = do+    allFixtures <-+        filter (/= "unterminated_brace.hcl") .+        filter (/= "unterminated_block_comment.hcl") .+        filter (/= "multiline_no_marker.hcl") .+        filter (/= "multiline_bad.hcl") .+        filter (takeExtension >>> (== ".hcl")) <$>+        getDirectoryContents "./test-fixtures"++    bs <- forM allFixtures $ \fixture -> do+        print fixture+        input <- Text.readFile ("./test-fixtures" </> fixture)+        input `seq` return ()+        return $ bench fixture $ nf+            (\i -> let Right h = parseHCL "" i in h) input++    defaultMain [ bgroup "parseHCL" bs+                ]
+ language-hcl.cabal view
@@ -0,0 +1,128 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           language-hcl+version:        0.1.1.0+synopsis:       hcl and conf parsers and pretty-printers for the Haskell programming language.+description:     @language-hcl@ contains HCL (Hashicorp Configuration Language) parsers and pretty-printers for the Haskell programming language.+                "Data.HCL" exports all the API surface in the package. +category:       Data+homepage:       https://github.com/beijaflor-io/haskell-language-hcl#readme+bug-reports:    https://github.com/beijaflor-io/haskell-language-hcl/issues+author:         Pedro Tacla Yamada+maintainer:     tacla.yamada@gmail.com+copyright:      Copyright (c) 2016 Pedro Tacla Yamada+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ./test-fixtures/basic.hcl+    ./test-fixtures/basic.json+    ./test-fixtures/basic_int_string.hcl+    ./test-fixtures/basic_squish.hcl+    ./test-fixtures/decode_policy.hcl+    ./test-fixtures/decode_policy.json+    ./test-fixtures/decode_tf_variable.hcl+    ./test-fixtures/decode_tf_variable.json+    ./test-fixtures/empty.hcl+    ./test-fixtures/escape.hcl+    ./test-fixtures/flat.hcl+    ./test-fixtures/float.hcl+    ./test-fixtures/float.json+    ./test-fixtures/interpolate_escape.hcl+    ./test-fixtures/multiline.hcl+    ./test-fixtures/multiline.json+    ./test-fixtures/multiline_bad.hcl+    ./test-fixtures/multiline_indented.hcl+    ./test-fixtures/multiline_no_eof.hcl+    ./test-fixtures/multiline_no_hanging_indent.hcl+    ./test-fixtures/multiline_no_marker.hcl+    ./test-fixtures/nested_block_comment.hcl+    ./test-fixtures/nested_provider_bad.hcl+    ./test-fixtures/object_list.json+    ./test-fixtures/scientific.hcl+    ./test-fixtures/scientific.json+    ./test-fixtures/slice_expand.hcl+    ./test-fixtures/structure.hcl+    ./test-fixtures/structure.json+    ./test-fixtures/structure2.hcl+    ./test-fixtures/structure2.json+    ./test-fixtures/structure_flat.json+    ./test-fixtures/structure_flatmap.hcl+    ./test-fixtures/structure_list.hcl+    ./test-fixtures/structure_list.json+    ./test-fixtures/structure_list_deep.json+    ./test-fixtures/structure_multi.hcl+    ./test-fixtures/structure_multi.json+    ./test-fixtures/terraform_heroku.hcl+    ./test-fixtures/terraform_heroku.json+    ./test-fixtures/tfvars.hcl+    ./test-fixtures/unterminated_block_comment.hcl+    ./test-fixtures/unterminated_brace.hcl++source-repository head+  type: git+  location: https://github.com/beijaflor-io/haskell-language-hcl++library+  hs-source-dirs:+      src+  build-depends:+      base >=4.8 && <5+    , deepseq+    , directory >=1.2.2.0+    , filepath >=1.4.0.0+    , megaparsec >=5+    , pretty+    , scientific >=0.3.4.6+    , semigroups >=0.18.1+    , text >=1.2.2.1+    , unordered-containers+  exposed-modules:+      Data.HCL+      Data.HCL.PrettyPrint+      Data.HCL.Types+  default-language: Haskell2010++test-suite hspec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  build-depends:+      QuickCheck+    , base+    , directory+    , filepath+    , hspec+    , language-hcl+    , megaparsec+    , hspec-megaparsec+    , pretty+    , semigroups >=0.18.1+    , text+    , transformers >=0.4.2.0+  other-modules:+      Data.HCL.PrettyPrintSpec+      Data.HCL.TestHelper+      Data.HCLSpec+      SanitySpec+  default-language: Haskell2010++benchmark hcl-benchmark+  type: exitcode-stdio-1.0+  main-is: HCLBenchmark.hs+  hs-source-dirs:+      bench+  ghc-options: -O2 -threaded+  build-depends:+      base+    , criterion+    , directory+    , filepath+    , language-hcl+    , text+  default-language: Haskell2010
+ src/Data/HCL.hs view
@@ -0,0 +1,221 @@+{-|+Module: Data.HCL+Description: Exports a @.hcl@ Megaparsec parser through 'hcl'+Copyright: (c) Copyright Pedro Tacla Yamada 2016+License: MIT+Maintainer: tacla.yamada@gmail.com+Stability: experimental+Portability: unknown++This modules contains the 'hcl' Megaparsec parser for @hcl@ files.++The pretty-printer is at "Data.HCL.PrettyPrint".+-}+{-# LANGUAGE OverloadedStrings #-}+module Data.HCL+    (+      -- * Entry-points+      parseHCL+    , hcl+    , runParser+    , pPrintHCL+      -- * Types+    , HCLDoc (..)+    , HCLStatement (..)+    , HCLValue (..)+    , HCLList (..)+    , HCLStringPart (..)+      -- * Pretty-printer+    , Pretty (..)+      -- * Support functions+    , topValue+    , bplain+    , binterp+    , string+    , stringParts+    , stringPart+    , stringPlain+    , stringPlainMultiline+    , stringInterp+    , assignment+    , object+    , value+    , ident+    , keys+    , key+    , list+    , number+    )+  where++import           Control.Monad+import qualified Data.HashMap.Strict   as HashMap (fromList)+import           Data.Text             (Text)+import qualified Data.Text             as Text+import           Text.Megaparsec       (Dec, ParseError (..), alphaNumChar,+                                        anyChar, char, eof, eol, label,+                                        lookAhead, many, manyTill, optional,+                                        runParser, sepBy, sepBy1, skipMany,+                                        some, spaceChar, tab, try, (<|>))+import qualified Text.Megaparsec       as Megaparsec (string)+import qualified Text.Megaparsec.Lexer as Lexer+import           Text.Megaparsec.Text  (Parser)++import           Data.HCL.PrettyPrint+import           Data.HCL.Types++-- |+-- Parser for the HCL format+--+-- @+-- let h = runParser hcl fileName fileContents+-- @+--+-- See "Text.Megaparsec"+hcl :: Parser HCLDoc+hcl = many $ do+    skipSpace+    topValue++-- |+-- Shortcut for @runParser 'hcl'@+parseHCL :: String -> Text -> Either+    (ParseError Char Dec) HCLDoc+parseHCL = runParser hcl++topValue :: Parser HCLStatement+topValue = label "HCL - topValue" $+    HCLStatementObject <$> try object+    <|> HCLStatementAssignment <$> assignment++value :: Parser HCLValue+value = label "HCL - value" $+    try object+    <|> HCLList <$> list+    <|> number+    <|> HCLIdent <$> ident+    <|> HCLString <$> stringParts+    <|> HCLString <$> (do s <- stringPlainMultiline; return [HCLStringPlain s])++object :: Parser HCLValue+object = label "HCL - object" $ do+    ks <- keys+    skipSpace+    vchar '{'+    skipSpace+    fs <- manyTill assignment (vchar '}')+    skipSpace+    return $ HCLObject ks $ HashMap.fromList fs++keys :: Parser [Text]+keys = label "HCL - keys" $ many $ do+    k <- key+    skipSpace+    return k++assignment :: Parser ([Text], HCLValue)+assignment = label "HCL - assignment" $ do+    i <- sepBy1 ident (char '.')+    skipSpace+    vchar '='+    skipSpace+    v <- value+    skipSpace+    return (i, v)++vchar :: Char -> Parser ()+vchar =+    void . char++key :: Parser Text+key = string <|> ident++list :: Parser HCLList+list = do+    vchar '['+    skipSpace+    vs <- value `sepBy` (skipSpace >> comma >> skipSpace)+    skipSpace+    _ <- optional comma+    skipSpace+    vchar ']'+    return vs++comma :: Parser ()+comma =+    vchar ','++-- quote :: Parser ()+quote :: Parser String+quote = Lexer.symbol skipSpace "\""++bplain :: Text -> HCLValue+bplain s = HCLString [HCLStringPlain s]++binterp :: Text -> HCLValue+binterp s = HCLString [HCLStringInterp s]++stringParts :: Parser [HCLStringPart]+stringParts = label "HCL - stringParts" $ do+    _ <- quote+    manyTill stringPart quote++stringPart :: Parser HCLStringPart+stringPart = label "HCL - stringPart" $+    try (HCLStringInterp <$> stringInterp)+    <|> HCLStringPlain <$> stringPlain++stringInterp :: Parser Text+stringInterp = label "HCL - stringInterp" $ do+    _ <- Lexer.symbol skipSpace "${"+    Text.pack <$> manyTill anyChar (Megaparsec.string "}")++stringPlain :: Parser Text+stringPlain = label "HCL - stringPlain" $ do+    let end =+            try (lookAhead eof)+            <|> void (try (lookAhead (Megaparsec.string "${")))+            <|> void (try (lookAhead quote))+    s <- manyTill Lexer.charLiteral end+    return $ Text.pack s++stringPlainMultiline :: Parser Text+stringPlainMultiline = label "HCL - stringPlainMultiline" $ do+    _ <- Megaparsec.string "<<"+    _ <- optional (char '-')+    _ <- Megaparsec.string "EOF"+    _ <- eol+    Text.pack <$> manyTill Lexer.charLiteral+        (try (skipSpace >> Megaparsec.string "EOF"))++string :: Parser Text+string = label "HCL - string" $ try stringPlainMultiline <|> str+  where+    str = do+        _ <- quote+        s <- manyTill Lexer.charLiteral quote+        return $ Text.pack s++number :: Parser HCLValue+number =+    HCLNumber <$> Lexer.number++ident :: Parser Text+ident = Text.pack <$> some (alphaNumChar <|> char '_' <|> char '-')++skipSpace :: Parser ()+skipSpace = skipMany $+    skipLineComment+    <|> skipBlockComment+    <|> void eol+    <|> void spaceChar+    <|> void tab++skipLineComment :: Parser ()+skipLineComment =+    Lexer.skipLineComment "#"+    <|> Lexer.skipLineComment "//"++skipBlockComment :: Parser ()+skipBlockComment =+    Lexer.skipBlockComment "/*" "*/"
+ src/Data/HCL/PrettyPrint.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-|+Module: Data.HCL.PrettyPrint+Description: Exports a @.hcl@ pretty-printer+Copyright: (c) Copyright Pedro Tacla Yamada 2016+License: MIT+Maintainer: tacla.yamada@gmail.com+Stability: experimental+Portability: unknown++This modules contains the 'hcl' pretty-printer for "Data.HCL" data. Declares a+'Pretty' instance for 'HCLStatement' and 'HCLValue'.+-}+module Data.HCL.PrettyPrint+    (+      pPrintHCL+    , Pretty (..)+    , Doc (..)+    )+  where++import           Data.HashMap.Strict            (toList)+import           Data.HCL.Types+import qualified Data.Text                      as Text+import           Text.PrettyPrint+import           Text.PrettyPrint.HughesPJClass++-- | Pretty-prints a 'HCLDoc' to a 'Doc'+--+-- 'pPrint' restricted to 'HCLDoc'.+--+-- @+-- print (pPrintConf c)+-- @+--+-- See "Text.PrettyPrint"+pPrintHCL :: HCLDoc -> Doc+pPrintHCL = pPrint++instance Pretty HCLStatement where+    pPrint s = case s of+        HCLStatementObject o -> pPrint o+        HCLStatementAssignment (is, v) ->+            hcat (punctuate "." (map (text . Text.unpack) is)) <+>+            "=" <+> pPrint v+    pPrintList _ ss = foldl ($+$) empty (map pPrint ss)++instance Pretty HCLValue where+    pPrint v = case v of+        HCLNumber n -> text (show n)+        HCLString ps -> hcat (map pPrint ps)+        HCLIdent t -> pPrint (Text.unpack t)+        HCLObject ks h -> hsep (map pPrintKey ks) <+> "{" $+$+                          nest 2 (pPrintFields h)+                          $+$ "}"+        HCLList vs -> hcat (punctuate comma (map pPrint vs))++instance Pretty HCLStringPart where+    pPrint s = case s of+        HCLStringPlain t -> pPrint (Text.unpack t)+        HCLStringInterp t -> "#{" <> pPrint (Text.unpack t) <> "}"++pPrintKey k = let s = Text.unpack k+              in if ' ' `elem` s then text (show s)+                 else text s++pPrintFields h = pPrintList undefined+    (map (\(f, v) -> HCLStatementAssignment (f, v)) (toList h))+
+ src/Data/HCL/Types.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}+module Data.HCL.Types where++import           Control.DeepSeq     (NFData)+import           Data.HashMap.Strict (HashMap)+import           Data.Scientific     (Scientific)+import           Data.Text           (Text)+import           GHC.Generics        (Generic)++-- | The HCL document is just a list of statements+type HCLDoc = [HCLStatement]++-- | Statements may be "objects", of form:+--+-- @+-- provider "aws" {+-- # more+-- }+-- @+--+-- Or they may be assignments:+--+-- @+-- a = "b"+-- @+data HCLStatement = HCLStatementObject HCLValue+                  | HCLStatementAssignment ([Text], HCLValue)+  deriving(Generic, Show, Eq, NFData)++data HCLValue = HCLNumber Scientific+              | HCLString [HCLStringPart]+              | HCLIdent Text+              | HCLObject [Text] (HashMap [Text] HCLValue)+              | HCLList [HCLValue]+  deriving(Generic, Show, Eq, NFData)++type HCLList = [HCLValue]++data HCLStringPart = HCLStringPlain Text+                   | HCLStringInterp Text+  deriving(Generic, Show, Eq, NFData)
+ test-fixtures/basic.hcl view
@@ -0,0 +1,2 @@+foo = "bar"
+bar = "${file("bing/bong.txt")}"
+ test-fixtures/basic.json view
@@ -0,0 +1,4 @@+{
+	"foo": "bar",
+    "bar": "${file(\"bing/bong.txt\")}"
+}
+ test-fixtures/basic_int_string.hcl view
@@ -0,0 +1,1 @@+count = "3"
+ test-fixtures/basic_squish.hcl view
@@ -0,0 +1,3 @@+foo="bar"+bar="${file("bing/bong.txt")}"+foo-bar="baz"
+ test-fixtures/decode_policy.hcl view
@@ -0,0 +1,15 @@+key "" {+	policy = "read"+}++key "foo/" {+	policy = "write"+}++key "foo/bar/" {+	policy = "read"+}++key "foo/bar/baz" {+	policy = "deny"+}
+ test-fixtures/decode_policy.json view
@@ -0,0 +1,19 @@+{+    "key": {+        "": {+            "policy": "read"+        },++        "foo/": {+            "policy": "write"+        },++        "foo/bar/": {+            "policy": "read"+        },++        "foo/bar/baz": {+            "policy": "deny"+        }+    }+}
+ test-fixtures/decode_tf_variable.hcl view
@@ -0,0 +1,10 @@+variable "foo" {+    default = "bar"+    description = "bar"+}++variable "amis" {+    default = {+        east = "foo"+    }+}
+ test-fixtures/decode_tf_variable.json view
@@ -0,0 +1,14 @@+{+    "variable": {+        "foo": {+            "default": "bar",+            "description": "bar"+        },++        "amis": {+            "default": {+                "east": "foo"+            }+        }+    }+}
+ test-fixtures/empty.hcl view
@@ -0,0 +1,1 @@+resource "foo" {}
+ test-fixtures/escape.hcl view
@@ -0,0 +1,1 @@+foo = "bar\"baz\\n"
+ test-fixtures/flat.hcl view
@@ -0,0 +1,2 @@+foo = "bar"
+Key = 7
+ test-fixtures/float.hcl view
@@ -0,0 +1,1 @@+a = 1.02
+ test-fixtures/float.json view
@@ -0,0 +1,3 @@+{+	"a": 1.02+}
+ test-fixtures/interpolate_escape.hcl view
@@ -0,0 +1,1 @@+foo="${file(\"bing/bong.txt\")}"
+ test-fixtures/multiline.hcl view
@@ -0,0 +1,4 @@+foo = <<EOF+bar+baz+EOF
+ test-fixtures/multiline.json view
@@ -0,0 +1,3 @@+{+    "foo": "bar\nbaz"+}
+ test-fixtures/multiline_bad.hcl view
@@ -0,0 +1,4 @@+foo = <EOF+bar+baz+EOF
+ test-fixtures/multiline_indented.hcl view
@@ -0,0 +1,4 @@+foo = <<-EOF+        bar+        baz+      EOF
+ test-fixtures/multiline_no_eof.hcl view
@@ -0,0 +1,5 @@+foo = <<EOF+bar+baz+EOF+key = "value"
+ test-fixtures/multiline_no_hanging_indent.hcl view
@@ -0,0 +1,5 @@+foo = <<-EOF+  baz+    bar+      foo+      EOF
+ test-fixtures/multiline_no_marker.hcl view
@@ -0,0 +1,1 @@+foo = <<
+ test-fixtures/nested_block_comment.hcl view
@@ -0,0 +1,5 @@+/*+foo = "bar/*"+*/++bar = "value"
+ test-fixtures/nested_provider_bad.hcl view
@@ -0,0 +1,5 @@+resource "aws" "web" {+  provider = "aws" {+    region = "us-west-2"+  }+}
+ test-fixtures/object_list.json view
@@ -0,0 +1,15 @@+{+    "resource": {+        "aws_instance": {+            "db": {+                "vpc": "foo",+                "provisioner": [{+                    "file": {+                        "source": "foo",+                        "destination": "bar"+                    }+                }]+            }+		}+	}+}
+ test-fixtures/scientific.hcl view
@@ -0,0 +1,6 @@+a = 1e-10+b = 1e+10+c = 1e10+d = 1.2e-10+e = 1.2e+10+f = 1.2e10
+ test-fixtures/scientific.json view
@@ -0,0 +1,8 @@+{+    "a": 1e-10,+    "b": 1e+10,+    "c": 1e10,+    "d": 1.2e-10,+    "e": 1.2e+10,+    "f": 1.2e10+}
+ test-fixtures/slice_expand.hcl view
@@ -0,0 +1,7 @@+service "my-service-0" {+  key = "value"+}++service "my-service-1" {+  key = "value"+}
+ test-fixtures/structure.hcl view
@@ -0,0 +1,5 @@+// This is a test structure for the lexer+foo "baz" {+	key = 7+	foo = "bar"+}
+ test-fixtures/structure.json view
@@ -0,0 +1,8 @@+{
+	"foo": [{
+		"baz": [{
+			"key": 7,
+			"foo": "bar"
+		}]
+	}]
+}
+ test-fixtures/structure2.hcl view
@@ -0,0 +1,9 @@+// This is a test structure for the lexer
+foo "baz" {
+	key = 7
+	foo = "bar"
+}
+
+foo {
+	key = 7
+}
+ test-fixtures/structure2.json view
@@ -0,0 +1,10 @@+{
+	"foo": [{
+		"baz": {
+			"key": 7,
+			"foo": "bar"
+		}
+    }, {
+		"key": 7
+	}]
+}
+ test-fixtures/structure_flat.json view
@@ -0,0 +1,8 @@+{
+	"foo": {
+		"baz": {
+			"key": 7,
+			"foo": "bar"
+		}
+	}
+}
+ test-fixtures/structure_flatmap.hcl view
@@ -0,0 +1,7 @@+foo {
+	key = 7
+}
+
+foo {
+	foo = "bar"
+}
+ test-fixtures/structure_list.hcl view
@@ -0,0 +1,6 @@+foo {+    key = 7+}+foo {+    key = 12+}
+ test-fixtures/structure_list.json view
@@ -0,0 +1,7 @@+{+	"foo": [{+        "key": 7+    }, {+        "key": 12+    }]+}
+ test-fixtures/structure_list_deep.json view
@@ -0,0 +1,16 @@+{+    "bar": {+        "foo": {+            "name": "terraform_example",+            "ingress": [+                {+                    "from_port": 22+                },+                {+                    "from_port": 80+                }+            ]+        }+    }+}+
+ test-fixtures/structure_multi.hcl view
@@ -0,0 +1,7 @@+foo "baz" {+	key = 7+}++foo "bar" {+	key = 12+}
+ test-fixtures/structure_multi.json view
@@ -0,0 +1,11 @@+{+	"foo": {+		"baz": {+			"key": 7+		},++		"bar": {+			"key": 12+		}+	}+}
+ test-fixtures/terraform_heroku.hcl view
@@ -0,0 +1,5 @@+name = "terraform-test-app"++config_vars {+    FOO = "bar"+}
+ test-fixtures/terraform_heroku.json view
@@ -0,0 +1,6 @@+{+    "name": "terraform-test-app",+    "config_vars": {+        "FOO": "bar"+    }+}
+ test-fixtures/tfvars.hcl view
@@ -0,0 +1,3 @@+regularvar = "Should work"+map.key1 = "Value"+map.key2 = "Other value"
+ test-fixtures/unterminated_block_comment.hcl view
@@ -0,0 +1,2 @@+/*+Foo
+ test-fixtures/unterminated_brace.hcl view
@@ -0,0 +1,2 @@+foo "baz" {+    bar = "baz"
+ test/Data/HCL/PrettyPrintSpec.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedLists   #-}+{-# LANGUAGE OverloadedStrings #-}+module Data.HCL.PrettyPrintSpec where++import           Data.HCL.PrettyPrint+import           Data.HCL.Types+import           Test.Hspec+import           Text.PrettyPrint.HughesPJClass++spec :: Spec+spec =+    describe "pPrint" $+        it "pretty prints an HCL document" $ do+            let input :: HCLDoc+                input =  [ HCLStatementAssignment ( ["hello", "world"]+                                                  , HCLString [HCLStringPlain "Hello World"]+                                                  )+                         , HCLStatementAssignment (["var"], HCLNumber 10)+                         , HCLStatementObject+                           (HCLObject+                             ["resource", "something h"]+                             [ (["something"], HCLString [HCLStringPlain "Here"])+                             ]+                           )+                         ]+            prettyShow input `shouldBe`+                -- We use init because there's no trailing newline+                init (unlines [ "hello.world = \"Hello World\""+                              , "var = 10.0"+                              , "resource \"something h\" {"+                              , "  something = \"Here\""+                              , "}"+                              ])
+ test/Data/HCL/TestHelper.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE FlexibleContexts #-}+module Data.HCL.TestHelper where++import           Data.HCL+import           Data.Text            (Text)+import           Test.Hspec+import           Text.Megaparsec+import           Text.Megaparsec.Text++-- testParser :: Parser Text -> Text -> Text -> Expectation+-- testParser p i o = case runParser p "" i of+--     Left e -> error (show e)+--     Right a -> a `shouldBe` o++-- testFailure :: FilePath -> Parser a -> Text -> Expectation+-- testFailure fp p i = case runParser p fp i of+--     Right _ -> error "This should have failed"+--     _ -> True `shouldBe` True++testParser+    :: (Eq a, Show e, Show a, Show (Token s))+    => Parsec e s a -> s -> a -> Expectation+testParser p i o = case runParser p "" i of+    Left e -> error (show e)+    Right a -> a `shouldBe` o++testFailure :: String -> Text -> Expectation+testFailure fp inp = case parseHCL fp inp of+    Right _ -> error "This should have failed"+    _ -> True `shouldBe` True++testFailureP :: Parser Text -> String -> Text -> Expectation+testFailureP p fp inp = case runParser p fp inp of+    Right _ -> error "This should have failed"+    _ -> True `shouldBe` True
+ test/Data/HCLSpec.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedLists   #-}+{-# LANGUAGE OverloadedStrings #-}+module Data.HCLSpec where++import           Control.Monad+import           Control.Monad.IO.Class+import           Data.HCL+import           Data.HCL.TestHelper+import           Data.Text              (Text)+import qualified Data.Text              as Text+import qualified Data.Text.IO           as Text+import           System.Directory+import           System.FilePath+import           System.IO.Unsafe+import           Test.Hspec+import           Text.Megaparsec        (Parsec, Token (..), runParser)++{-# NOINLINE fs' #-}+fs' :: [FilePath]+fs' = unsafePerformIO $ do+    fs <- liftIO (getDirectoryContents "./test-fixtures")+    return $ filter ((== ".hcl") . takeExtension) fs++spec :: Spec+spec = do+    describe "stringParts" $ do+        it "parses normal strings" $ do+            let input = "\"something\""+            testParser stringParts input [HCLStringPlain "something"]++        it "parses interpolated strings" $ do+            let input = "\"${asdf} Hello World asdfasdf ${hey}\""+            testParser stringParts input [ HCLStringInterp "asdf"+                                         , HCLStringPlain " Hello World asdfasdf "+                                         , HCLStringInterp "hey"+                                         ]++    describe "ident" $ do+        it "parses alphanum" $ do+            let input = "asdf"+            testParser ident input "asdf"++        it "parses dashes" $ do+            let input = "asdf-asdf"+            testParser ident input "asdf-asdf"++        it "parses underscores" $ do+            let input = "asdf_asdf"+            testParser ident input "asdf_asdf"++        it "stops at whitespace" $ do+            let input = "asdf asdf"+            testParser ident input "asdf"++    describe "stringPlain" $ do+        it "parses the empty string" $ do+            let input = ""+            testParser stringPlain input ""++        it "parses charaters" $ do+            let input = "something"+            testParser stringPlain input "something"++        it "parses escape sequences" $ do+            let input = "bar\\\"baz\\n"+            testParser stringPlain input "bar\"baz\n"++    describe "stringPlainMultiline" $+        it "parses multiline strings" $ do+            let input = Text.unlines [ "<<EOF"+                                     , "stuff"+                                     , "here"+                                     , "EOF"+                                     ]+            testParser stringPlainMultiline input "stuff\nhere"++    describe "assignment" $ do+        it "parses weird string assignments (escaping)" $ do+            let input = "foo = \"bar\\\"\\n\""+            testParser assignment input (["foo"], bplain "bar\"\n")++        it "parses HashiCorp's escape.hcl" $ do+            input <- Text.readFile "./test-fixtures/escape.hcl"+            testParser assignment input (["foo"], bplain "bar\"baz\\n")++        it "parses string assignments" $ do+            let input = "foo = \"bar\""+            testParser assignment input (["foo"], bplain "bar")++        it "parses assignments to numbers" $ do+            let input = "foo = 10"+            testParser assignment input (["foo"], HCLNumber 10)++        it "parses assignments to lists" $ do+            let input = "foo = [1, 2, 3]"+            testParser assignment input+                (["foo"], HCLList [HCLNumber 1, HCLNumber 2, HCLNumber 3])++        it "parses multiline string assignments" $ do+            let input = Text.unlines [ "bar = <<EOF"+                                     , "hello there"+                                     , "here"+                                     , "EOF"+                                     ]+            testParser assignment input+                (["bar"], bplain "hello there\nhere")++        it "parses nested assignments" $ do+            let input = "foo.bar = 10"+            testParser assignment input+                (["foo", "bar"], HCLNumber 10)++        it "fails to parse empty identifiers" $ do+            let input = " = 10"+            testFailure "" input++        it "parses assignments to objects" $ do+            let input = "foo = { name = \"john\" }"+            testParser assignment input+                (["foo"], HCLObject [] [(["name"], bplain "john")])++    describe "parseHCL" $ do+        it "parses basic assignments" $ do+            let input = Text.unlines [ "foo = \"bar\""+                                     , "bar = \"foo\""+                                     ]+            testParser hcl input+                [ HCLStatementAssignment (["foo"], bplain "bar")+                , HCLStatementAssignment (["bar"], bplain "foo")+                ]++        it "parses multiline string assignments" $ do+            let input = Text.unlines [ "bar = <<EOF"+                                     , "hello there"+                                     , "here"+                                     , "EOF"+                                     ]+            testParser hcl input+                [ HCLStatementAssignment (["bar"], bplain "hello there\nhere")+                ]++        it "parses interpolated assignments" $ do+            let input = Text.unlines [ "foo = \"bar\""+                                     , "bar = \"${file(\"bing/bong.txt\")}\""+                                     ]+            testParser hcl input+                [ HCLStatementAssignment (["foo"], bplain "bar")+                , HCLStatementAssignment (["bar"], binterp "file(\"bing/bong.txt\")")+                ]++        it "parses complex interpolated assignments" $ do+            let input = Text.unlines [ "foo = \"bar\""+                                     , "bar = \"stuff/${file(\"bing/bong.txt\")}\""+                                     ]+            testParser hcl input+                [ HCLStatementAssignment (["foo"], bplain "bar")+                , HCLStatementAssignment ( ["bar"]+                                         , HCLString [ HCLStringPlain "stuff/"+                                                     , HCLStringInterp "file(\"bing/bong.txt\")"+                                                     ]+                                         )+                ]++    describe "Hashicorp Test Suite" $ forM_ fs' $ \fp -> it fp $ do+        inp <- liftIO $ Text.readFile ("test-fixtures" </> fp)+        case fp of+            "unterminated_block_comment.hcl" -> testFailure fp inp+            "multiline_no_marker.hcl" -> testFailure fp inp+            "multiline_bad.hcl" -> testFailure fp inp+            "unterminated_brace.hcl" -> testFailure fp inp+            _ -> case parseHCL fp inp of+                    Left e -> error (show e)+                    Right _ -> True `shouldBe` True
+ test/SanitySpec.hs view
@@ -0,0 +1,6 @@+module SanitySpec where++import Test.Hspec++spec = describe "when I have tests" $+    it "I have sanity" $ True `shouldBe` True
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}