haskell-src-meta-0.8.2: tests/Main.hs

{-# LANGUAGE CPP #-}

module Main where

import Language.Haskell.Meta.Parse
import qualified Language.Haskell.Exts as Exts
import qualified Language.Haskell.Exts.Extension as Extension
import qualified Language.Haskell.Exts.Parser as Parser
import qualified Language.Haskell.TH as TH
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.HUnit (Assertion, (@?=))

main :: IO ()
main = defaultMain tests

tests :: [Test]
tests = [ derivingClausesTest
#if MIN_VERSION_template_haskell(2,12,0)
        , typeAppTest
#endif
        ]

derivingClausesTest :: Test
derivingClausesTest = testCase "Deriving clauses preserved" $
    roundTripDecls "data Foo = Foo deriving (A, B, C)"

typeAppMode :: Exts.ParseMode
typeAppMode = Parser.defaultParseMode { Parser.extensions = [Extension.EnableExtension Extension.TypeApplications] }

typeAppTest :: Test
typeAppTest = testCase "Type app preserved" $
  roundTripDeclsWithMode typeAppMode "tenStr = show @Int 10"

roundTripDecls :: String -> Assertion
roundTripDecls s = do
    declsExts  <- liftEither $ parseHsDecls s
    declsExts' <- liftEither $ parseDecs s >>= parseHsDecls . TH.pprint
    declsExts' @?= declsExts

roundTripDeclsWithMode :: Exts.ParseMode -> String -> Assertion
roundTripDeclsWithMode mode s = do
  declsExts <- liftEither $ parseHsDeclsWithMode mode s
  declsExts' <- liftEither $ parseDecsWithMode mode s >>= parseHsDeclsWithMode mode . TH.pprint
  declsExts' @?= declsExts

liftEither :: Monad m => Either String a -> m a
liftEither = either fail return