content: 
  import Data.Semigroup (Semigroup,
                         (<>))
  import Test.QuickCheck (arbitrary,
                          Arbitrary,
                          CoArbitrary,
                          elements,
                          Gen,
                          quickCheck,
                          sample)
  
  -- Semigroup exercises
  -- 1.
  
  data Trivial = Trivial deriving (Eq, Show)
  
  instance Semigroup Trivial where
    _ <> _ = Trivial
  
  instance Arbitrary Trivial where
    arbitrary = return Trivial
  
  semigroupAssoc :: (Eq s, Semigroup s) => s -> s -> s -> Bool
  semigroupAssoc a b c = (a <> (b <> c)) == ((a <> b) <> c)
  
  type TrivialAssoc = Trivial -> Trivial -> Trivial -> Bool
  
  -- 2.
  
  newtype Identity a = Identity a
  
  instance Semigroup a => Semigroup (Identity a) where
    Identity a <> Identity a' = Identity (a <> a')
  
  instance Eq a => Eq (Identity a) where
    Identity a == Identity a' = a == a'
  
  testIdEq :: Eq a => Identity a -> Identity a -> Bool
  testIdEq x x' = (x == x') == (\(Identity a) (Identity b) -> a == b) x x'
  
  
  instance (Show a) => Show (Identity a) where
    show (Identity a) = "Identity " ++ show a
  
  testIdShow :: Show a => Identity a -> Bool
  testIdShow x = show x == (\(Identity a) -> "Identity " ++ show a) x
  
  genId :: Arbitrary a => Gen (Identity a)
  genId = do
   x <- arbitrary
   return $ Identity x
  
  instance Arbitrary a => Arbitrary (Identity a) where
    arbitrary = genId
  
  -- 3.
  
  data Two a b = Two a b
  
  -- instances
  
  instance (Semigroup a, Semigroup b) => Semigroup (Two a b) where
    Two a b <> Two a' b' = Two (a <> a') (b <> b')
  
  instance (Eq a, Eq b) => Eq (Two a b) where
    Two a b == Two a' b' = (a == a') && (b == b')
  
  instance (Show a, Show b) => Show (Two a b) where
    show (Two a b) = "Two " ++ show a ++ " " ++ show b 
  
  -- tests
  
  testTwoEq :: (Eq a, Eq b) => Two a b -> Two a b -> Bool
  testTwoEq x x' = (x == x') == (\(Two a b) (Two a' b') ->
                                  (a == a') && (b == b')) x x'
  
  testTwoShow :: (Show a, Show b) => Two a b -> Bool
  testTwoShow x = show x ==
                  (\(Two a b) -> "Two " ++ show a ++ " " ++ show b) x
  
  -- generators
  
  genTwo :: (Arbitrary a, Arbitrary b) => Gen (Two a b)
  genTwo = do
   x <- arbitrary
   y <- arbitrary
   return $ Two x y
  
  instance (Arbitrary a, Arbitrary b) => Arbitrary (Two a b) where
    arbitrary = genTwo
  
  -- 4.
  
  data Three a b c = Three a b c
  
  -- instances
  
  instance (Semigroup a, Semigroup b, Semigroup c)
      => Semigroup (Three a b c) where
          Three a b c <> Three a' b' c' =
              Three (a <> a') (b <> b') (c <> c')
  
  instance (Eq a, Eq b, Eq c) => Eq (Three a b c) where
      Three a b c == Three a' b' c' =
          (a == a') && (b == b') && (c == c')
  
  instance (Show a, Show b, Show c) => Show (Three a b c) where
    show (Three a b c) =
      "Three " ++ show a ++ " " ++ show b ++ " " ++ show c
  
  -- tests
  
  testThreeEq :: (Eq a, Eq b, Eq c) => Three a b c -> Three a b c -> Bool
  testThreeEq x x' = (x == x') == (\(Three a b c) (Three a' b' c') ->
                                  (a == a') && (b == b') && (c == c')) x x'
  
  testThreeShow :: (Show a, Show b, Show c) => Three a b c -> Bool
  testThreeShow x =
      show x ==
             (\(Three a b c) ->
                  "Three " ++ show a ++ " " ++ show b ++ " " ++ show c) x
  
  -- generators
  
  genThree :: (Arbitrary a, Arbitrary b, Arbitrary c)
            => Gen (Three a b c)
  genThree = do
   x <- arbitrary
   y <- arbitrary
   z <- arbitrary
   return $ Three x y z
  
  instance (Arbitrary a, Arbitrary b, Arbitrary c) =>
      Arbitrary (Three a b c) where
    arbitrary = genThree
  
  -- 5.
  
  data Four a b c d = Four a b c d
  
  -- instances
  
  instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)
      => Semigroup (Four a b c d) where
          Four a b c d <> Four a' b' c' d' =
              Four (a <> a') (b <> b') (c <> c') (d <> d')
  
  instance (Eq a, Eq b, Eq c, Eq d) => Eq (Four a b c d) where
      Four a b c d == Four a' b' c' d' =
          (a == a') && (b == b') && (c == c') && (d == d')
  
  instance (Show a, Show b, Show c, Show d) => Show (Four a b c d) where
    show (Four a b c d) =
      "Four " ++ show a ++ " " ++ show b ++ " " ++ show c ++ " " ++ show d
  
  -- tests
  
  testFourEq :: (Eq a, Eq b, Eq c, Eq d) => Four a b c d -> Four a b c d -> Bool
  testFourEq x x' = (x == x') ==
                    (\(Four a b c d) (Four a' b' c' d') ->
                     (a == a') && (b == b') && (c == c') && (d == d')) x x'
  
  testFourShow :: (Show a, Show b, Show c, Show d) => Four a b c d -> Bool
  testFourShow x =
      show x ==
             (\(Four a b c d) ->
                  "Four " ++ show a ++ " " ++ show b ++
                  " " ++ show c ++ " " ++ show d) x
  
  -- generators
  
  genFour :: (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
            => Gen (Four a b c d)
  genFour = do
    w <- arbitrary
    x <- arbitrary
    y <- arbitrary
    z <- arbitrary
    return $ Four w x y z
  
  instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) =>
      Arbitrary (Four a b c d) where
    arbitrary = genFour
  
  -- 6.
  
  newtype BoolConj = BoolConj Bool
  
  instance Semigroup BoolConj where
    BoolConj True <> BoolConj True = BoolConj True
    BoolConj _ <> BoolConj _ = BoolConj False
  
  instance Eq BoolConj where
    BoolConj a == BoolConj a' = a == a'
  
  testBCEq :: BoolConj -> BoolConj -> Bool
  testBCEq x x' = (x == x') == (\(BoolConj a) (BoolConj b) -> a == b) x x'
  
  -- We must test expected behaviour
  testBCConj :: BoolConj -> BoolConj -> Bool
  testBCConj x x' = (\(BoolConj a) -> a) (x <> x') ==
                    (\(BoolConj a) (BoolConj b) -> a && b) x x'
  
  instance Show BoolConj where
    show (BoolConj a) = "BoolConj " ++ show a
  
  testBCShow :: BoolConj -> Bool
  testBCShow x = show x == (\(BoolConj a) -> "BoolConj " ++ show a) x
  
  genBC :: Gen BoolConj
  genBC = do
    b <- arbitrary :: Gen Bool
    return $ BoolConj b
  
  instance Arbitrary BoolConj where
    arbitrary = genBC
  
  -- 7.
  
  newtype BoolDisj = BoolDisj Bool
  
  instance Semigroup BoolDisj where
    BoolDisj False <> BoolDisj False = BoolDisj False
    BoolDisj _ <> BoolDisj _ = BoolDisj True
  
  instance Eq BoolDisj where
    BoolDisj a == BoolDisj a' = a == a'
  
  instance Show BoolDisj where
    show (BoolDisj x) = "BoolDisj " ++ show x
  
  -- generator
  
  genBD :: Gen BoolDisj
  genBD = do
    b <- arbitrary :: Gen Bool
    return $ BoolDisj b
  
  instance Arbitrary BoolDisj where
    arbitrary = genBD
  
  -- tests
  
  testBDDisj :: BoolDisj -> BoolDisj -> Bool
  testBDDisj x x' = (\(BoolDisj a) -> a) (x <> x') ==
                    (\(BoolDisj a) (BoolDisj b) -> a || b) x x'
  
  testBDEq :: BoolDisj -> BoolDisj -> Bool
  testBDEq x x' = (x == x') == (\(BoolDisj a) (BoolDisj b) -> a == b) x x'
  
  testBDShow :: BoolDisj -> Bool
  testBDShow x = show x == (\(BoolDisj a) -> "BoolDisj " ++ show a) x
  
  -- 8. Or Semigroup
  
  data Or a b = Fst a | Snd b
  
  -- Or Instances
  
  instance Semigroup (Or a b) where
    Fst _ <> Fst x = Fst x
    Fst _ <> Snd x = Snd x
    Snd x <> Fst _ = Snd x
    Snd x <> Snd _ = Snd x
    
  instance (Show a, Show b) => Show (Or a b) where
      show (Fst x) = "Fst " ++ show x
      show (Snd x) = "Snd " ++ show x
  
  instance (Eq a, Eq b) => Eq (Or a b) where
    Fst _ == Snd _ = False
    Snd _ == Fst _ = False
    Fst x == Fst x' = x == x'
    Snd x == Snd x' = x == x'
  
  -- Or tests
  
  testOr :: (Eq a, Eq b) => Or a b -> Or a b -> Bool
  testOr x x' = case (x, x') of
    (Fst _, Fst b) -> x <> x' == Fst b
    (Fst _, Snd b) -> x <> x' == Snd b
    (Snd b, Fst _) -> x <> x' == Snd b
    (Snd b, Snd _) -> x <> x' == Snd b
  
  testOrEq :: (Eq a, Eq b) => Or a b -> Or a b -> Bool
  testOrEq x x' = case (x, x') of
    (Fst _, Snd _) -> (x == x') == False
    (Snd _, Fst _) -> (x == x') == False
    (Fst a, Fst b) -> (x == x') == (a == b)
    (Snd a, Snd b) -> (x == x') == (a == b)
  
  testOrShow :: (Show a, Show b) => Or a b -> Bool
  testOrShow x = case x of
    Fst a -> show x == "Fst " ++ show a
    Snd a -> show x == "Snd " ++ show a
  
  -- Or generator
  
  genOr :: (Arbitrary a, Arbitrary b) => Gen (Or a b)
  genOr = do
    a <- arbitrary 
    b <- arbitrary
    elements [Fst a, Snd b]
  
  instance (Arbitrary a, Arbitrary b) => Arbitrary (Or a b) where
    arbitrary = genOr
  
  -- 9. Combine
  
  newtype Combine a b = Combine { unCombine :: a -> b }
  
  instance Semigroup b => Semigroup (Combine a b) where
    Combine f <> Combine g = Combine (f <> g)
  
  instance Show (Combine a b) where
    show (Combine _) = "Combine instance" -- not very useful
  
  -- OK, giving up on Eq instance
  
  -- Combine generator
  
  genFunc :: (CoArbitrary a, Arbitrary b) => Gen (a -> b)
  genFunc = arbitrary
  
  genCombine :: (CoArbitrary a, Arbitrary b) => Gen (Combine a b)
  genCombine = do
    f <- genFunc
    return $ Combine f
  
  instance (CoArbitrary a, Arbitrary b) => Arbitrary (Combine a b) where
      arbitrary = genCombine
  
  -- Certainly useless without Eq or Show instances
  
  -- 10. Comp
  
  newtype Comp a = Comp { unComp :: (a -> a) }
  
  instance Semigroup a => Semigroup (Comp a) where
    Comp x <> Comp x' = Comp (x <> x')
  
  -- Still don't know how to Eq or Show functions
  
  -- 11. Validation
  
  data Validation a b =
    Failure a | Success b
    deriving (Eq, Show)
  
  instance Semigroup (Validation a b) where
        Failure x <> Success _ = Failure x
        Success _ <> Failure x = Failure x
        Failure x <> Failure _ = Failure x
        Success x <> Success _ = Success x
  
  instance (Arbitrary a, Arbitrary b) => Arbitrary (Validation a b) where
    arbitrary = genValidation
  
  genValidation :: (Arbitrary a, Arbitrary b) => Gen (Validation a b)
  genValidation = do
    a <- arbitrary
    b <- arbitrary
    elements [Failure a, Success b]
  
  testValidSemi :: (Eq a, Eq b) => Validation a b -> Validation a b -> Bool
  testValidSemi x x' = case (x, x') of
    (Failure a, Success _) -> x <> x' == Failure a
    (Success _, Failure a) -> x <> x' == Failure a
    (Failure a, Failure _) -> x <> x' == Failure a
    (Success a, Success _) -> x <> x' == Success a
    
  
  -- 12. AccumulateRight
  
  newtype AccumulateRight a b =
    AccumulateRight (Validation a b)
    deriving (Eq, Show)
  
  instance Semigroup b => Semigroup (AccumulateRight a b) where
    AccumulateRight (Failure x) <>
      AccumulateRight (Success _) =
        AccumulateRight (Failure x)
    AccumulateRight (Failure _) <>
      AccumulateRight (Failure x) =
        AccumulateRight (Failure x)
    AccumulateRight (Success _) <>
      AccumulateRight (Failure x) =
        AccumulateRight (Failure x)
    AccumulateRight (Success _) <>
      AccumulateRight (Success x) =
        AccumulateRight (Success x)
  
  testAccR :: (Eq a, Eq b, Semigroup a, Semigroup b) =>
              AccumulateRight a b -> AccumulateRight a b -> Bool
  testAccR x x' = case (x, x') of
    (AccumulateRight(Failure a),
     AccumulateRight(Success _)) -> x <> x' == AccumulateRight(Failure a)
    (AccumulateRight(Success _),
     AccumulateRight(Failure a)) -> x <> x' == AccumulateRight(Failure a)
    (AccumulateRight(Failure _),
     AccumulateRight(Failure a)) -> x <> x' == AccumulateRight(Failure a)
    (AccumulateRight(Success _),
     AccumulateRight(Success a)) -> x <> x' == AccumulateRight(Success a)
  
  instance (Arbitrary a, Arbitrary b) => Arbitrary (AccumulateRight a b) where
    arbitrary = genAccR
  
  genAccR :: (Arbitrary a, Arbitrary b) => Gen (AccumulateRight a b)
  genAccR = do
    a <- genValidation
    return $ AccumulateRight a
  
  -- 13. AccumulateBoth
  
  newtype AccumulateBoth a b =
    AccumulateBoth (Validation a b)
    deriving (Eq, Show)
  
  instance (Semigroup a, Semigroup b) =>
      Semigroup (AccumulateBoth a b) where
          AccumulateBoth (Failure x) <>
            AccumulateBoth (Failure x') =
               AccumulateBoth (Failure (x <> x'))
          AccumulateBoth (Success x) <>
            AccumulateBoth (Success x') =
              AccumulateBoth (Success (x <> x'))
          AccumulateBoth (Success _) <>
            AccumulateBoth (Failure x) =
              AccumulateBoth (Failure x)
          AccumulateBoth (Failure x) <>
            AccumulateBoth (Success _) =
              AccumulateBoth (Failure x)
  
  testAccB :: (Eq a, Eq b, Semigroup a, Semigroup b) =>
              AccumulateBoth a b -> AccumulateBoth a b -> Bool
  testAccB x x' = case (x, x') of
    (AccumulateBoth(Failure a),
     AccumulateBoth(Success _)) -> x <> x' == AccumulateBoth(Failure a)
    (AccumulateBoth(Success _),
     AccumulateBoth(Failure a)) -> x <> x' == AccumulateBoth(Failure a)
    (AccumulateBoth(Failure a),
     AccumulateBoth(Failure a')) -> x <> x' == AccumulateBoth(Failure (a <> a'))
    (AccumulateBoth(Success a),
     AccumulateBoth(Success a')) -> x <> x' == AccumulateBoth(Success (a <> a'))
  
  instance (Arbitrary a, Arbitrary b) => Arbitrary (AccumulateBoth a b) where
    arbitrary = genAccB
  
  genAccB :: (Arbitrary a, Arbitrary b) => Gen (AccumulateBoth a b)
  genAccB = do
    a <- genValidation
    return $ AccumulateBoth a
  
  
  -- main
  
  type S = String
  type Id = Identity
  type IdentityAssoc = Id S -> Id S -> Id S -> Bool
  type IdentityEq = Id S -> Id S -> Bool
  type TwoAssoc = Two S S -> Two S S -> Two S S -> Bool
  type TwoEq = Two S S -> Two S S -> Bool
  type ThreeAssoc = Three S S S -> Three S S S -> Three S S S -> Bool
  type ThreeEq = Three S S S -> Three S S S -> Bool
  type FourAssoc = Four S S S S -> Four S S S S -> Four S S S S -> Bool
  type FourEq = Four S S S S -> Four S S S S -> Bool
  type BC = BoolConj
  type BCAssoc = BC -> BC -> BC -> Bool
  type BDAssoc = BoolDisj -> BoolDisj -> BoolDisj -> Bool
  type OrAssoc = Or Int Char -> Or Int Char -> Or Int Char -> Bool
  type C = Combine
  type CombAssoc = C S S -> C S S -> C S S -> Bool -- unused
  type V = Validation
  type ValidAssoc = V S S -> V S S -> V S S -> Bool
  type AR = AccumulateRight
  type ARAssoc = AR S S -> AR S S -> AR S S -> Bool
  type AB = AccumulateBoth
  type ABAssoc = AB S S -> AB S S -> AB S S -> Bool
  
  main :: IO ()
  main = do
    putStrLn "\n Trivial"
    quickCheck (semigroupAssoc :: TrivialAssoc)
    putStrLn "\n Identity"
    quickCheck (semigroupAssoc :: IdentityAssoc)
    quickCheck (testIdEq :: IdentityEq)
    quickCheck (testIdShow :: Id String -> Bool)
    putStrLn "\n Two"
    quickCheck (semigroupAssoc :: TwoAssoc)
    quickCheck (testTwoEq :: TwoEq)
    quickCheck (testTwoShow :: Two Int Float -> Bool)
    putStrLn "\n Three"
    quickCheck (semigroupAssoc :: ThreeAssoc)
    quickCheck (testThreeEq :: ThreeEq)
    quickCheck (testThreeShow :: Three S S S -> Bool)
    putStrLn "\n Four"
    quickCheck (semigroupAssoc :: FourAssoc)
    quickCheck (testFourEq :: FourEq)
    quickCheck (testFourShow :: Four S S S S -> Bool)
    putStrLn "\n BoolConj"
    quickCheck (semigroupAssoc :: BCAssoc)
    quickCheck testBCConj
    quickCheck testBCEq
    quickCheck testBCShow
    putStrLn "\n BoolDisj"
    quickCheck (semigroupAssoc :: BDAssoc)
    quickCheck testBDDisj
    quickCheck testBDEq
    quickCheck testBDShow
    putStrLn "\n Or"
    quickCheck (semigroupAssoc :: OrAssoc)
    quickCheck (testOr :: Or Int Char -> Or Int Char -> Bool)
    quickCheck (testOrEq :: Or Int Char -> Or Int Char -> Bool)
    quickCheck (testOrShow :: Or Int Char -> Bool)
    -- putStrLn "\n Combine"
    -- quickCheck (semigroupAssoc :: CombAssoc)
    putStrLn "\n Validation"
    quickCheck (semigroupAssoc :: ValidAssoc)
    quickCheck (testValidSemi :: V S S -> V S S -> Bool)
    putStrLn "\n AccumulateRight"
    quickCheck (semigroupAssoc :: ARAssoc)
    quickCheck (testAccR :: AR (V S S) (V S S) -> AR (V S S) (V S S) -> Bool)
    putStrLn "\n AccumulateBoth"
    quickCheck (semigroupAssoc :: ABAssoc)
    quickCheck (testAccB :: AB (V S S) (V S S) -> AB (V S S) (V S S) -> Bool)
  