packages feed

symantic-parser-0.2.0.20210703: test/Golden/Machine.hs

{-# LANGUAGE DataKinds #-} -- For using P.viewMachine
{-# LANGUAGE FlexibleContexts #-} -- For machines
{-# LANGUAGE GADTs #-} -- For machines
{-# LANGUAGE TypeApplications #-} -- For P.viewMachine
module Golden.Machine where

import Data.Bool (Bool(..))
import Data.Char (Char)
import Control.Monad (Monad(..))
import Data.Int (Int)
import Data.Function (($))
import Data.Functor ((<$>))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Data.Text (Text)
import System.IO (IO)
import Test.Tasty
import Test.Tasty.Golden
import Text.Show (Show(..))
import qualified Data.List as List

import Golden.Utils
import Grammar
import qualified Symantic.Parser as P

goldens :: TestTree
goldens = testGroup "Machine" $
  (\f -> List.zipWith f (machines @Text) [1::Int ..]) $ \mach g ->
  let machineFile = getGoldenDir $ "Machine/G"<>show g<>".expected.txt" in
  goldenVsStringDiff ("G"<>show g) goldenDiff machineFile $ do
    resetTHNameCounter
    m <- mach
    return $ fromString $ show $
      P.viewMachine @'False m

machines ::
  P.InputToken inp ~ Char =>
  P.Cursorable (P.Cursor inp) =>
  P.Machinable (P.InputToken inp) repr =>
  [IO (repr inp '[] String)]
machines = P.optimizeMachine <$> grammars