content: {-# LANGUAGE OverloadedLists #-}
  
  -- |  Directly ported from puppet specs
  module Interpreter.CollectorSpec (spec) where
  
  import Control.Lens
  import qualified Data.Text as Text
  import Helpers
  import Test.Hspec
  
  shouldNotify :: [Text] -> [PValue] -> Expectation
  shouldNotify content expectedMessages = do
    catalog <- case pureCatalog (Text.unlines content) of
      Left rr -> fail rr
      Right (x, _) -> pure x
    let messages = itoList catalog ^.. folded . filtered (\rp -> rp ^. _1 . itype == "notify") . _2 . rattributes . ix "message"
    messages `shouldMatchList` expectedMessages
  
  shouldFail :: [Text] -> Expectation
  shouldFail content =
    let catalog = pureCatalog (Text.unlines content)
     in catalog `shouldSatisfy` has _Left
  
  spec =
    describe "Collectors" $ do
      spec0
      spec1
  
  spec0 :: Spec
  spec0 = do
    it "matches everything when no query given" $
      [ "@notify { 'testing': message => 'the message' }",
        "@notify { 'other': message => 'the other message' }",
        "Notify <| |>"
      ]
        `shouldNotify` ["the other message", "the message"]
    it "matches regular resources" $
      [ "notify { \"testing\": message => \"the message\" }",
        "notify { \"other\": message => \"the other message\" }",
        "Notify <| |> { message => \"changed\" }"
      ]
        `shouldNotify` ["changed", "changed"]
    it "matches on tags" $
      [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
        "@notify { \"other\": tag => [\"two\"], message => \"unwanted\" }",
        "Notify <| tag == one |>"
      ]
        `shouldNotify` ["wanted"]
    it "matches on title" $
      [ "@notify { \"testing\": message => \"the message\" }",
        "Notify <| title == \"testing\" |>"
      ]
        `shouldNotify` ["the message"]
    it "matches on other parameters" $
      [ "@notify { \"testing\": message => \"the message\" }",
        "@notify { \"other testing\": message => \"the wrong message\" }",
        "Notify <| message == \"the message\" |>"
      ]
        `shouldNotify` ["the message"]
    it "matches against elements of an array valued parameter" $
      [ "@notify { \"testing\": message => [\"the\", \"message\"] }",
        "@notify { \"other testing\": message => [\"not\", \"here\"] }",
        "Notify <| message == \"message\" |>"
      ]
        `shouldNotify` [PArray ["the", "message"]]
    it "matches with bare word" $
      [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
        "Notify <| tag == one |>"
      ]
        `shouldNotify` ["wanted"]
    it "matches with single quoted string" $
      [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
        "Notify <| tag == 'one' |>"
      ]
        `shouldNotify` ["wanted"]
    it "matches with double quoted string" $
      [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
        "Notify <| tag == \"one\" |>"
      ]
        `shouldNotify` ["wanted"]
    it "matches with double quoted string with interpolated expression" $
      [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
        "$x = 'one'",
        "Notify <| tag == \"$x\" |>"
      ]
        `shouldNotify` ["wanted"]
    it "matches with resource references" $ do
      pending
      shouldNotify
        [ "@notify { \"foobar\": }",
          "@notify { \"testing\": require => Notify[\"foobar\"], message => \"wanted\" }",
          "Notify <| require == Notify[\"foobar\"] |>"
        ]
        ["wanted"]
    it "allows criteria to be combined with 'and'" $
      [ "@notify { \"testing\": message => \"the message\" }",
        "@notify { \"other\": message => \"the message\" }",
        "Notify <| title == \"testing\" and message == \"the message\" |>"
      ]
        `shouldNotify` ["the message"]
    it "allows criteria to be combined with 'or'" $
      [ "@notify { \"testing\": message => \"the message\" }",
        "@notify { \"other\": message => \"other message\" }",
        "@notify { \"yet another\": message => \"different message\" }",
        "Notify <| title == \"testing\" or message == \"other message\" |>"
      ]
        `shouldNotify` ["the message", "other message"]
    it "allows criteria to be grouped with parens" $
      [ "@notify { \"testing\":     message => \"different message\", withpath => true }",
        "@notify { \"other\":       message => \"the message\" }",
        "@notify { \"yet another\": message => \"the message\",       withpath => true }",
        "Notify <| (title == \"testing\" or message == \"the message\") and withpath == true |>"
      ]
        `shouldNotify` ["the message", "different message"]
    it "does not do anything if nothing matches" $
      [ "@notify { \"testing\": message => \"different message\" }",
        "Notify <| title == \"does not exist\" |>"
      ]
        `shouldNotify` []
    it "excludes items with inequalities" $
      [ "@notify { \"testing\": message => \"good message\" }",
        "@notify { \"the wrong one\": message => \"bad message\" }",
        "Notify <| title != \"the wrong one\" |>"
      ]
        `shouldNotify` ["good message"]
    it "does not exclude resources with unequal arrays" $
      [ "@notify { \"testing\": message => \"message\" }",
        "@notify { \"the wrong one\": message => [\"not this message\", \"or this one\"] }",
        "Notify <| message != \"not this message\" |>"
      ]
        `shouldNotify` ["message", PArray ["not this message", "or this one"]]
    it "does not exclude tags with inequalities" $
      [ "@notify { \"testing\": tag => [\"wanted\"], message => \"wanted message\" }",
        "@notify { \"other\": tag => [\"why\"], message => \"the way it works\" }",
        "Notify <| tag != \"why\" |>"
      ]
        `shouldNotify` ["wanted message", "the way it works"]
    it "does not collect classes" $
      shouldFail
        [ "class theclass {",
          "    @notify { \"testing\": message => \"good message\" }",
          "}",
          "Class <|  |>"
        ]
    it "does not collect resources that don't exist" $ do
      pending
      shouldFail
        [ "class theclass {",
          "    @notify { \"testing\": message => \"good message\" }",
          "}",
          "SomeResource <|  |>"
        ]
    it "modifies an existing array" $
      [ "@notify { \"testing\": message => [\"original message\"] }",
        "Notify <| |> {",
        "    message +> \"extra message\"",
        "}"
      ]
        `shouldNotify` [PArray ["original message", "extra message"]]
    it "converts a scalar to an array" $
      [ "@notify { \"testing\": message => \"original message\" }",
        "Notify <| |> {",
        "    message +> \"extra message\"",
        "}"
      ]
        `shouldNotify` [PArray ["original message", "extra message"]]
    it "collects and overrides virtual resources multiple times using multiple collects" $
      [ "@notify { \"testing\": message => \"original\" }",
        "Notify <|  |> { message => 'overridden1' }",
        "Notify <|  |> { message => 'overridden2' }"
      ]
        `shouldNotify` ["overridden2"]
    it "collects and overrides non virtual resources multiple times using multiple collects" $
      [ "notify { \"testing\": message => \"original\" }",
        "Notify <|  |> { message => 'overridden1' }",
        "Notify <|  |> { message => 'overridden2' }"
      ]
        `shouldNotify` ["overridden2"]
  
  spec1 :: Spec
  spec1 = do
    let computeWith = pureCatalog . arrowOperationInput
    describe "Resource Collector" $
      it "should append the new 'uid' attribute in the user resource" $
        getResAttr (computeWith "=>") ^. at "uid" `shouldBe` Just (PNumber 1000)
    describe "AppendArrow in AttributeDecl" $
      it "should add 'docker' to the 'groups' attribute of the user resource" $ do
        getResAttr (computeWith "+>") ^. at "groups" `shouldBe` Just (PArray ["ci", "docker"])
    describe "AssignArrow in AttributeDecl" $
      it "should override the 'groups' attributes from the user resource" $
        getResAttr (computeWith "=>") ^. at "groups" `shouldBe` Just (PArray ["docker"])
    where
      getResAttr :: Either String (FinalCatalog, InterpreterWriter) -> Container PValue
      getResAttr s = s ^. _Right . _1 . at (RIdentifier "user" "jenkins") . _Just . rattributes
  
      arrowOperationInput :: Text -> Text
      arrowOperationInput arr =
        Text.unlines
          [ "user { 'jenkins':",
            "  groups => 'ci'",
            "}",
            "User <| title == 'jenkins' |> {",
            "groups " <> arr <> " 'docker',",
            "uid => 1000}",
            "}"
          ]
  