content: {-# LANGUAGE OverloadedStrings #-}
  module SubtypingSpec(main, spec) where
  
  import           SubtypeRelation as S
  import           Sort
  
  import           Test.Hspec
  
  main :: IO ()
  main = hspec spec
  
  spec :: Spec
  spec = do
  
    let rel = S.insert "B" "A"
            $ S.insert "C" "B"
            $ S.insert "B'" "A"
            $ S.insert "C" "B'"
            $ S.insert (List "B") "BList"
            $ S.insert (Option "B") "BOption"
            $ S.insert (Tuple ["B","B"]) "BTuple"
              S.empty
  
    it "is a reflexive relation" $ do
      S.subtype rel "A" "A" `shouldBe` True
      S.subtype rel "B" "B" `shouldBe` True
      S.subtype rel "B'" "B'" `shouldBe` True
      S.subtype rel "C" "C" `shouldBe` True
      S.subtype rel Top Top `shouldBe` True
      S.subtype rel Bottom Bottom `shouldBe` True
  
    it "is a transitive relation" $ do
      S.subtype rel "C" "B" `shouldBe` True
      S.subtype rel "C" "B'" `shouldBe` True
      S.subtype rel "B" "A" `shouldBe` True
      S.subtype rel "B'" "A" `shouldBe` True
      S.subtype rel "C" "A" `shouldBe` True
  
    it "handles list" $ do
      S.subtype rel (List "C") (List "A") `shouldBe` True
      S.subtype rel (List "C") (List "B") `shouldBe` True
      S.subtype rel (List "C") (List "C") `shouldBe` True
      S.subtype rel (List "C") (List Top) `shouldBe` True
      S.subtype rel (List "C") Top `shouldBe` True
      S.subtype rel (List Bottom) (List Top) `shouldBe` True
      S.subtype rel (List Top) (List Top) `shouldBe` True
      S.subtype rel (List Top) Top `shouldBe` True
      S.subtype rel Bottom (List Bottom) `shouldBe` True
      S.subtype rel (List Bottom) "BList" `shouldBe` True
      S.subtype rel (List "C") "BList" `shouldBe` True
  
    it "handles option" $ do
      S.subtype rel (Option "C") (Option "A") `shouldBe` True
      S.subtype rel (Option "C") (Option "B") `shouldBe` True
      S.subtype rel (Option "C") (Option "C") `shouldBe` True
      S.subtype rel (Option "C") (Option Top) `shouldBe` True
      S.subtype rel (Option "C") Top `shouldBe` True
      S.subtype rel (Option Bottom) (Option Top) `shouldBe` True
      S.subtype rel (Option Top) (Option Top) `shouldBe` True
      S.subtype rel (Option Top) Top `shouldBe` True
      S.subtype rel Bottom (Option Bottom) `shouldBe` True
      S.subtype rel (Option Bottom) "BOption" `shouldBe` True
      S.subtype rel (Option "C") "BOption" `shouldBe` True
  
    it "handles Tuple" $ do
      S.subtype rel (Tuple ["C","C"]) (Tuple ["A","A"]) `shouldBe` True
      S.subtype rel (Tuple ["B","C"]) (Tuple ["A","B"]) `shouldBe` True
      S.subtype rel (Tuple ["B","C"]) (Tuple ["B","C"]) `shouldBe` True
      S.subtype rel (Tuple ["B","B"]) (Tuple ["B","C"]) `shouldBe` False
      S.subtype rel (Tuple ["B","B"]) (Tuple ["B","B","B"]) `shouldBe` False
      S.subtype rel (Tuple ["A","B"]) (Tuple [Top,"A"]) `shouldBe` True
      S.subtype rel (Tuple ["A","B"]) (Tuple [Top,Top]) `shouldBe` True
      S.subtype rel (Tuple [Top,"B"]) (Tuple [Top,"A"]) `shouldBe` True
      S.subtype rel (Tuple [Top,"B"]) (Tuple [Top,Top]) `shouldBe` True
      S.subtype rel (Tuple [Top,"B"]) (Tuple ["A",Top]) `shouldBe` False
      S.subtype rel (Tuple [Bottom,Bottom]) "BTuple" `shouldBe` True
      S.subtype rel (Tuple ["C",Bottom]) "BTuple" `shouldBe` True
      S.subtype rel (Tuple [Bottom,"C"]) "BTuple" `shouldBe` True
      S.subtype rel (Tuple ["C","C"]) "BTuple" `shouldBe` True
  
    it "has a smallest element" $ do
      and [S.subtype rel Bottom s | s <- ["A","B","B'","C"]]
        `shouldBe` True
      or [S.subtype rel s Bottom | s <- ["A","B","B'","C"]]
        `shouldBe` False
  
    it "has a largest element" $ do
      or [S.subtype rel Top s | s <- ["A","B","B'","C"]]
        `shouldBe` False
      and [S.subtype rel s Top | s <- ["A","B","B'","C"]]
        `shouldBe` True
  