Discovery.hs

{-# LANGUAGE QuasiQuotes #-}

-- | Tests for contracts discovery.

module Test.Lorentz.Discovery
  ( test_Export_list_parse
  , test_Haskell_modules_detection
  ) where

import Test.HUnit (assertFailure, (@?=))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)
import Text.InterpolatedString.QM (qnb)
import Text.Megaparsec (errorBundlePretty, runParser)

import Lorentz.Discover

test_Export_list_parse :: [TestTree]
test_Export_list_parse =
  [ testCase "Empty" $
    [qnb| module MyModule () where
        |] `shouldParseTo` []

  , testCase "Empty spaced" $
    [qnb| module MyModule (  ) where
        |] `shouldParseTo` []

  , testCase "Contracts extracted fine" $
      [qnb| module MyModule
              ( contract_Some
              , contract_one_another
              ) where
      |]
      `shouldParseTo`
       [ ExportedContractInfo
         { eciModuleName = "MyModule"
         , eciContractDecl = ExportedContractDecl
           { ecdName = "Some"
           , ecdVar = "contract_Some"
           }
         }
       , ExportedContractInfo
         { eciModuleName = "MyModule"
         , eciContractDecl = ExportedContractDecl
           { ecdName = "one another"
           , ecdVar = "contract_one_another"
           }
         }
       ]

  , testCase "Bad export entries are ignored" $
      [qnb| module MyModule
              ( not_a_contract
              , SomeType (..)
              , SomethingElse ( Ctor, getter )
              , SomethingElse2
                 ( Ctor2  -- constructor
                 , getter2  {- getter -})
              , contract
              , contract_Some
              ) where
      |]
      `shouldParseTo`
       [ ExportedContractInfo
         { eciModuleName = "MyModule"
         , eciContractDecl = ExportedContractDecl
           { ecdName = "Some"
           , ecdVar = "contract_Some"
           }
         }
       ]

  , testCase "Annotations and comments" $
      [qnb| {-# PRAGMA #-}
            -- Comment
            -- | Description
            {- Another comment
            -}
            module MyModule
              ( contract_Some  -- Should be exported

                -- ** And these should not
              , contract
              ) where
      |]
      `shouldParseTo`
       [ ExportedContractInfo
         { eciModuleName = "MyModule"
         , eciContractDecl = ExportedContractDecl
           { ecdName = "Some"
           , ecdVar = "contract_Some"
           }
         }
       ]

  ]
  where
    shouldParseTo code exports =
      case runParser haskellExportsParser "" code of
        Left err -> assertFailure $ errorBundlePretty err
        Right x -> x @?= exports


test_Haskell_modules_detection :: [TestTree]
test_Haskell_modules_detection =
  [ testCase "Simple module is picked" $
      isHaskellModule "Module.hs" @?= True
  , testCase "Not .hs module is ignored" $
      isHaskellModule "Module" @?= False
  , testCase "Modules with non letters are picked" $
      isHaskellModule "Module_12.hs" @?= True
  , testCase "Emacs' temporal files should be ignored" $
      isHaskellModule ".#Module.hs" @?= False
  ]