multiwalk-0.3.0.1: test/Main.hs

module Main (main) where

import Control.MultiWalk
import Data.Functor.Compose (Compose (..))
import Data.Functor.Identity (Identity (..))
import GHC.Generics (Generic)
import Test.Tasty
import Test.Tasty.HUnit

data Foo
  = Foo1 String
  | Foo2 String Foo
  | Foo3 [Int] String [[Int]] Int [Int]
  deriving (Eq, Show, Generic)

data FooTag

instance MultiTag FooTag where
  type
    MultiTypes FooTag =
      '[ String
       , Foo
       , Int
       , [Int]
       ]

instance MultiSub FooTag Foo where
  type
    SubTypes FooTag Foo =
      'SpecList
        '[ ToSpec Foo
         , ToSpec String
         , ToSpec (MatchWith [[Int]] (Trav (Compose [] []) Int))
         , ToSpec [Int]
         ]

instance MultiSub FooTag String where
  type SubTypes FooTag String = 'SpecLeaf

instance MultiSub FooTag Int where
  type SubTypes FooTag Int = 'SpecLeaf

instance MultiSub FooTag [Int] where
  type SubTypes FooTag [Int] = 'SpecList '[ToSpec (Trav [] Int)]

sampleFoo :: Foo
sampleFoo = Foo2 "bla" (Foo2 "blblo" (Foo1 "ok"))

list' :: FList Identity '[String, Foo, Int, [Int]]
list' = (Identity . ('2' :)) :.: pure :.: (Identity . (2 *)) :.: (\x -> Identity (x ++ x)) :.: FNil

sampleFoo2 :: Foo
sampleFoo2 = Foo3 [0, 1] "abc" [[4, 8, 9], [5, 6, 7]] 32 [2, 3]

tests :: TestTree
tests =
  testGroup
    "Tests"
    [ testGroup
        "Query"
        [ testCase "Foo" $
            query @FooTag (\(x :: Foo) -> [x]) sampleFoo
              @?= [Foo2 "bla" (Foo2 "blblo" (Foo1 "ok")), Foo2 "blblo" (Foo1 "ok"), Foo1 "ok"]
        , testCase "String" $
            query @FooTag (\(x :: String) -> [x]) sampleFoo
              @?= ["bla", "blblo", "ok"]
        ]
    , testCase "ModSub" $
        walkSub @FooTag list' sampleFoo2
          @?= Identity (Foo3 [0, 1, 0, 1] "2abc" [[8, 16, 18], [10, 12, 14]] 32 [2, 3, 2, 3])
    ]

main :: IO ()
main = defaultMain tests