content: module Camfort.Specification.Stencils.ParserSpec (spec) where
  
  import Data.Either (isLeft)
  
  import Camfort.Specification.Parser (runParser)
  import qualified Camfort.Specification.Parser as Parser
  import Camfort.Specification.Stencils.Parser (specParser, SpecParseError)
  import Camfort.Specification.Stencils.Parser.Types
  import Camfort.Specification.Stencils.Model (
      Approximation(..)
    , Multiplicity(..))
  import qualified Camfort.Specification.Stencils.Syntax as Syn
  
  import Test.Hspec hiding (Spec)
  import qualified Test.Hspec as Test
  
  -- | Helper for building stencil strings.
  stencilString :: String -> String
  stencilString body = "= stencil " ++ body ++ " :: a"
  
  -- | Helper for building stencils.
  mkSpec :: Multiplicity (Approximation Region) -> Either a Specification
  mkSpec m = Right (SpecDec (SpecInner m True) ["a"])
  
  modifierTest :: String -> (Region -> Multiplicity (Approximation Region)) -> SpecWith ()
  modifierTest modifiers f =
    it ("modified with " ++ modifiers) $ parse (stencilString (modifiers ++ " r1 + r2"))
    `shouldBe` (mkSpec . f $ Or (Var "r1") (Var "r2"))
  
  -- | Check that a stencil specification does not parse.
  --
  -- Automatically inserts a leading "= stencil " and trailing " :: a".
  invalidStencilTest :: String -> String -> SpecWith ()
  invalidStencilTest description stencilStr =
    it description $ parse (stencilString stencilStr) `shouldSatisfy` isLeft
  
  -- | Check that a stencil specification does not parse.
  --
  -- Tests the @stencilStr@ as is.
  invalidStencilTest' :: String -> String -> SpecWith ()
  invalidStencilTest' description stencilStr =
    it description $ parse stencilStr `shouldSatisfy` isLeft
  
  -- | Check that a stencil specification does not parse, and that the
  -- error string matches that provided.
  --
  -- Tests the @stencilStr@ as is.
  invalidStencilTestStr :: String -- ^ Test description
                        -> String -- ^ Specification string
                        -> String -- ^ Expected error string
                        -> SpecWith ()
  invalidStencilTestStr description stencilStr errStr =
    it description $ show (parse stencilStr) `shouldBe` ("Left " ++ errStr)
  
  spec :: Test.Spec
  spec =
    describe "Stencils - Parser" $ do
      it "basic unmodified stencil" $
        parse (stencilString "r1 + r2")
        `shouldBe`
          mkSpec (Mult . Exact $ Or (Var "r1") (Var "r2"))
  
      context "with modifiers" $ do
        modifierTest "readOnce,"          (Once . Exact)
        modifierTest "atLeast,"           (Mult . (`Bound` Nothing) . Just)
        modifierTest "atMost,"            (Mult . Bound Nothing . Just)
        modifierTest "readOnce, atLeast," (Once . (`Bound` Nothing) . Just)
        modifierTest "readOnce, atMost,"  (Once . Bound Nothing . Just)
  
      describe "modifiers are case insensitive" $ do
        modifierTest "readOnce, atLeast," (Once . (`Bound` Nothing) . Just)
        modifierTest "readOnce, atMost,"  (Once . Bound Nothing . Just)
        modifierTest "readonce, atleast," (Once . (`Bound` Nothing) . Just)
        modifierTest "readonce, atmost,"  (Once . Bound Nothing . Just)
  
      let dimDepthTest (depth, dim) =
            let depthDim = concat ["depth=", depth, ", dim=", dim]
            in it depthDim $
            parse (stencilString $ concat ["forward(", depthDim, ")"])
            `shouldBe` mkSpec (Mult . Exact $ RegionConst $
                                       Syn.Forward (read depth) (read dim) True)
  
      describe "depth and dim" $
          mapM_ dimDepthTest [("1", "1"), ("10", "20")]
  
      describe "invalid stencils" $ do
        invalidStencilTest "approximation before multiplicity"
          "atLeast, readOnce r1"
        invalidStencilTest "repeated multiplicities"
          "readOnce, readOnce r1"
        invalidStencilTest "repeated approximations"
          "atLeast, atLeast, r1"
        invalidStencilTest "multiple approximations"
          "atLeast, atMost, r1"
        invalidStencilTest "zero dim"
          "forward(depth=1, dim=0)"
        invalidStencilTest "zero depth"
          "forward(depth=0, dim=1)"
        invalidStencilTest "negative dim"
          "forward(depth=1, dim=-1)"
        invalidStencilTest "negative depth"
          "forward(depth=-1, dim=1)"
        invalidStencilTest "just pointed stencil"
          "pointed(dims=1,2)"
        invalidStencilTest "basic monfieid stencil (2)"
          "atleast, pointed(dims=1,2), forward(depth=1, dim=1)"
        invalidStencilTest "basic stencil with pointed and nonpointed"
          "atleast, pointed(dims=2),  \
              \        nonpointed(dims=1), forward(depth=1, dim=1)"
        invalidStencilTest "complex stencil"
          "atleast, pointed(dims=1,2), readonce, \
              \ (forward(depth=1, dim=1) + r) * backward(depth=3, dim=4)"
        invalidStencilTest "pointed/nonpointed on same dim"
          "atleast, nonpointed(dims=2), pointed(dims=1,2), \
               \ forward(depth=1, dim=1)"
        invalidStencilTest' "empty specification"
          "= stencil"
        invalidStencilTest' "only identifier"
          "= stencil foo"
  
      it "basic modified stencil (1)" $
        parse (stencilString "      readonce, r1 + r2")
        `shouldBe`
          mkSpec (Once . Exact $ Or (Var "r1") (Var "r2"))
  
  
      let regionTestCase isRefl =
            Right (RegionDec "r"
                    (Or (RegionConst (Syn.Forward 1 1 isRefl))
                     (RegionConst (Syn.Backward 2 2 isRefl))))
      it "region defn" $
        parse "= region :: r = forward(depth=1, dim=1) + backward(depth=2, dim=2)"
        `shouldBe`
          regionTestCase True
  
      it "region defn syntactic permutation" $
        parse "= region :: r = forward(dim=1,depth=1) + backward(depth=2, dim=2)"
        `shouldBe`
          regionTestCase True
  
      it "region defn irreflx syntactic permutation" $
        parse "= region :: r = forward(nonpointed,dim=1,depth=1) + backward(depth=2,nonpointed,dim=2)"
        `shouldBe`
          regionTestCase False
  
      describe "error messages" $ do
        invalidStencilTestStr "invalid identifier"
          "= stencil foo$ :: a"
          "Invalid character in identifier: '$'"
        invalidStencilTestStr "invalid syntax"
          "= stencil readonce, readonce, pointed(dim=1) :: a"
          "Could not parse specification at: \"readonce... \"\n"
  
  parse :: String -> Either (Parser.SpecParseError SpecParseError) Specification
  parse = runParser specParser
  
  -- Local variables:
  -- mode: haskell
  -- haskell-program-name: "cabal repl test-suite:spec"
  -- End:
  