1 {-# LANGUAGE DataKinds #-} -- For using P.viewMachine
2 {-# LANGUAGE FlexibleContexts #-} -- For machines
3 {-# LANGUAGE GADTs #-} -- For machines
4 {-# LANGUAGE TypeApplications #-} -- For P.viewMachine
5 module Golden.Machine where
7 import Data.Bool (Bool(..))
8 import Data.Char (Char)
9 import Control.Monad (Monad(..))
11 import Data.Function (($))
12 import Data.Functor ((<$>))
13 import Data.Semigroup (Semigroup(..))
14 import Data.String (String, IsString(..))
15 import Data.Text (Text)
18 import Test.Tasty.Golden
19 import Text.Show (Show(..))
20 import qualified Data.List as List
24 import qualified Symantic.Parser as P
27 goldens = testGroup "Machine" $
28 (\f -> List.zipWith f (machines @Text) [1::Int ..]) $ \mach g ->
29 let machineFile = getGoldenDir $ "Machine/G"<>show g<>".expected.txt" in
30 goldenVsStringDiff ("G"<>show g) goldenDiff machineFile $ do
33 return $ fromString $ show $
34 P.viewMachine @'False m
37 P.InputToken inp ~ Char =>
38 P.Cursorable (P.Cursor inp) =>
39 P.Machinable (P.InputToken inp) repr =>
40 [IO (repr inp '[] String)]
41 machines = P.optimizeMachine <$> grammars