{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnboxedTuples #-} module Golden.Splice.T1 where import Control.Monad (Monad(..)) import Data.Char (Char) import Data.Either (Either(..)) import Data.Function (($)) import Data.Semigroup (Semigroup(..)) import Data.String (String, IsString(..)) import Data.Text (Text) import Data.Text.IO (readFile) import System.IO (IO, FilePath) import Test.Tasty import Test.Tasty.Golden import Text.Show (Show(..)) import qualified Data.ByteString.Lazy as BSL import qualified Data.IORef as IORef import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import qualified Language.Haskell.TH.Syntax as TH import qualified Symantic.Parser as P import qualified Symantic.Parser.Haskell as H import qualified Parser --import Golden.Utils {- goldensParser :: TestTree goldensParser = testGroup "Parser" [ testGroup "runParser" $ tests $ \name p -> let file = "test/Golden/Parser/"<>name in goldenVsStringDiff (file<>".txt") diffGolden (file<>".dump") $ do input :: Text <- readFile (file<>".txt") return $ fromString $ case p input of Left err -> show err Right a -> show a ] where tests :: (forall a. Show a => String -> (Text -> Either (P.ParsingError Text) a) -> TestTree) -> [TestTree] tests test = [ test "char" $$(P.runParser $ P.char 'a') , test "string" $$(P.runParser $ P.string "abc") , test "string-fail-horizon" $$(P.runParser $ P.string "abc") , test "many-char" $$(P.runParser $ P.many (P.char 'a')) , test "some-string" $$(P.runParser $ P.some (P.string "abcd")) , test "some-string-fail" $$(P.runParser $ P.some (P.string "abcd")) , test "some-string-eof-fail" $$(P.runParser $ P.some (P.string "abcd") P.<* P.eof) , test "alt-right-notry" $$(P.runParser $ P.traverse P.char "aa" P.<|> P.traverse P.char "ab") , test "alt-right-try" $$(P.runParser $ P.string "aa" P.<|> P.string "ab") , test "alt-left" $$(P.runParser $ P.string "aa" P.<|> P.string "ab") , test "many-char-eof" $$(P.runParser $ P.many (P.char 'r') P.<* P.eof) , test "eof" $$(P.runParser $ P.eof) , test "eof-fail" $$(P.runParser $ P.eof) , test "alt-char-fail" $$(P.runParser $ P.char 'a' P.<|> P.char 'b') , test "many-char-fail" $$(P.runParser $ P.many (P.char 'a') P.<* P.char 'b') , test "many-oneOf" $$(P.runParser $ P.many (P.oneOf ['a', 'b', 'c', 'd']) P.<* P.eof) ] -} -- | Resetting 'TH.counter' makes 'makeLetName' deterministic, -- except when flags change, like profiling -- or even --accept unfortunately, -- in those case the 'goldensMachine' tests may fail -- due to a different numbering of the 'def' and 'ref' combinators. resetTHNameCounter :: IO () resetTHNameCounter = IORef.writeIORef TH.counter 0