{-# OPTIONS_GHC -Wno-orphans #-}

module LawfulConversions.Relations.IntSetAndSetOfInt where

import LawfulConversions.Classes
import LawfulConversions.Prelude

instance IsSome (Set Int) IntSet where
  to :: IntSet -> Set Int
to = [Int] -> Set Int
[Item (Set Int)] -> Set Int
forall l. IsList l => [Item l] -> l
fromList ([Int] -> Set Int) -> (IntSet -> [Int]) -> IntSet -> Set Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntSet -> [Int]
IntSet -> [Item IntSet]
forall l. IsList l => l -> [Item l]
toList

instance IsSome IntSet (Set Int) where
  to :: Set Int -> IntSet
to = [Int] -> IntSet
[Item IntSet] -> IntSet
forall l. IsList l => [Item l] -> l
fromList ([Int] -> IntSet) -> (Set Int -> [Int]) -> Set Int -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Set Int -> [Int]
Set Int -> [Item (Set Int)]
forall l. IsList l => l -> [Item l]
toList

instance IsMany (Set Int) IntSet

instance IsMany IntSet (Set Int)

instance Is (Set Int) IntSet

instance Is IntSet (Set Int)