{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Test case fragments and fragment stores.
module Test.Mutagen.Fragment
  ( -- * Fragments and Fragmentable class
    IsFragment
  , Fragment (..)
  , Fragmentable (..)
  , singleton
  )
where

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable, cast)
import Data.Word (Word16, Word32, Word64, Word8)

{-------------------------------------------------------------------------------
-- * Fragments and Fragmentable class
-------------------------------------------------------------------------------}

-- | Fragment type class constraint.
type IsFragment a = (Typeable a, Ord a, Show a)

-- | A test case fragment hidden behind an existential.
data Fragment = forall a. (IsFragment a) => Fragment a

instance Eq Fragment where
  Fragment a
f1 == :: Fragment -> Fragment -> Bool
== Fragment a
f2 =
    case a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
f2 of
      Just a
f2' -> a
f1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
f2'
      Maybe a
Nothing -> Bool
False

instance Ord Fragment where
  compare :: Fragment -> Fragment -> Ordering
compare (Fragment a
f1) (Fragment a
f2) =
    case a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
f2 of
      Just a
f2' -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
f1 a
f2'
      Maybe a
Nothing -> Ordering
LT

instance Show Fragment where
  show :: Fragment -> String
show (Fragment a
a) = String
"Fragment(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

-- | Turn an entire value into a singleton fragment set.
singleton :: (IsFragment a) => a -> Set Fragment
singleton :: forall a. IsFragment a => a -> Set Fragment
singleton = Fragment -> Set Fragment
forall a. a -> Set a
Set.singleton (Fragment -> Set Fragment) -> (a -> Fragment) -> a -> Set Fragment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Fragment
forall a. IsFragment a => a -> Fragment
Fragment

-- ** Fragmentable class

-- | Types that can be fragmented into smaller pieces.
class (IsFragment a) => Fragmentable a where
  -- | Extract fragments from a value.
  fragmentize :: a -> Set Fragment
  fragmentize = a -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton

{-------------------------------------------------------------------------------
-- * Fragmentable instances
-------------------------------------------------------------------------------}

instance Fragmentable ()

instance Fragmentable Int

instance Fragmentable Double

instance Fragmentable Float

instance Fragmentable Word8

instance Fragmentable Word16

instance Fragmentable Word32

instance Fragmentable Word64

instance Fragmentable Char

instance Fragmentable Bool

instance (Fragmentable a) => Fragmentable (Maybe a) where
  fragmentize :: Maybe a -> Set Fragment
fragmentize Maybe a
x =
    case Maybe a
x of
      Maybe a
Nothing -> Maybe a -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton Maybe a
x
      Just a
v1 -> Maybe a -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton Maybe a
x Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
v1

instance (Fragmentable a, Fragmentable b) => Fragmentable (Either a b) where
  fragmentize :: Either a b -> Set Fragment
fragmentize (Left a
x) =
    forall a. IsFragment a => a -> Set Fragment
singleton @(Either a b) (a -> Either a b
forall a b. a -> Either a b
Left a
x)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
x
  fragmentize (Right b
x) =
    forall a. IsFragment a => a -> Set Fragment
singleton @(Either a b) (b -> Either a b
forall a b. b -> Either a b
Right b
x)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
x

instance (Fragmentable a) => Fragmentable [a] where
  fragmentize :: [a] -> Set Fragment
fragmentize [] = forall a. IsFragment a => a -> Set Fragment
singleton @[a] []
  fragmentize (a
x : [a]
xs) =
    forall a. IsFragment a => a -> Set Fragment
singleton @[a] (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
x
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> [a] -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize [a]
xs

instance (Fragmentable k, Fragmentable v) => Fragmentable (Map k v) where
  fragmentize :: Map k v -> Set Fragment
fragmentize Map k v
m =
    [Set Fragment] -> Set Fragment
forall a. Monoid a => [a] -> a
mconcat
      [ k -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize k
k Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> v -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize v
v
      | (k
k, v
v) <- Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m
      ]

-- Tuple instances

instance
  ( Fragmentable a
  , Fragmentable b
  )
  => Fragmentable (a, b)
  where
  fragmentize :: (a, b) -> Set Fragment
fragmentize (a
a, b
b) =
    (a, b) -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton (a
a, b
b)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
a
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
b

instance
  ( Fragmentable a
  , Fragmentable b
  , Fragmentable c
  )
  => Fragmentable (a, b, c)
  where
  fragmentize :: (a, b, c) -> Set Fragment
fragmentize (a
a, b
b, c
c) =
    (a, b, c) -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton (a
a, b
b, c
c)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
a
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
b
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> c -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize c
c

instance
  ( Fragmentable a
  , Fragmentable b
  , Fragmentable c
  , Fragmentable d
  )
  => Fragmentable (a, b, c, d)
  where
  fragmentize :: (a, b, c, d) -> Set Fragment
fragmentize (a
a, b
b, c
c, d
d) =
    (a, b, c, d) -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton (a
a, b
b, c
c, d
d)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
a
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
b
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> c -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize c
c
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> d -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize d
d

instance
  ( Fragmentable a
  , Fragmentable b
  , Fragmentable c
  , Fragmentable d
  , Fragmentable e
  )
  => Fragmentable (a, b, c, d, e)
  where
  fragmentize :: (a, b, c, d, e) -> Set Fragment
fragmentize (a
a, b
b, c
c, d
d, e
e) =
    (a, b, c, d, e) -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton (a
a, b
b, c
c, d
d, e
e)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
a
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
b
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> c -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize c
c
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> d -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize d
d
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> e -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize e
e

instance
  ( Fragmentable a
  , Fragmentable b
  , Fragmentable c
  , Fragmentable d
  , Fragmentable e
  , Fragmentable f
  )
  => Fragmentable (a, b, c, d, e, f)
  where
  fragmentize :: (a, b, c, d, e, f) -> Set Fragment
fragmentize (a
a, b
b, c
c, d
d, e
e, f
f) =
    (a, b, c, d, e, f) -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton (a
a, b
b, c
c, d
d, e
e, f
f)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
a
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
b
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> c -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize c
c
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> d -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize d
d
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> e -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize e
e
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> f -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize f
f

instance
  ( Fragmentable a
  , Fragmentable b
  , Fragmentable c
  , Fragmentable d
  , Fragmentable e
  , Fragmentable f
  , Fragmentable g
  )
  => Fragmentable (a, b, c, d, e, f, g)
  where
  fragmentize :: (a, b, c, d, e, f, g) -> Set Fragment
fragmentize (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
    (a, b, c, d, e, f, g) -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton (a
a, b
b, c
c, d
d, e
e, f
f, g
g)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
a
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
b
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> c -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize c
c
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> d -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize d
d
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> e -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize e
e
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> f -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize f
f
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> g -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize g
g

instance
  ( Fragmentable a
  , Fragmentable b
  , Fragmentable c
  , Fragmentable d
  , Fragmentable e
  , Fragmentable f
  , Fragmentable g
  , Fragmentable h
  )
  => Fragmentable (a, b, c, d, e, f, g, h)
  where
  fragmentize :: (a, b, c, d, e, f, g, h) -> Set Fragment
fragmentize (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) =
    (a, b, c, d, e, f, g, h) -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
a
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
b
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> c -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize c
c
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> d -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize d
d
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> e -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize e
e
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> f -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize f
f
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> g -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize g
g
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> h -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize h
h

instance
  ( Fragmentable a
  , Fragmentable b
  , Fragmentable c
  , Fragmentable d
  , Fragmentable e
  , Fragmentable f
  , Fragmentable g
  , Fragmentable h
  , Fragmentable i
  )
  => Fragmentable (a, b, c, d, e, f, g, h, i)
  where
  fragmentize :: (a, b, c, d, e, f, g, h, i) -> Set Fragment
fragmentize (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) =
    (a, b, c, d, e, f, g, h, i) -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
a
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
b
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> c -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize c
c
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> d -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize d
d
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> e -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize e
e
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> f -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize f
f
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> g -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize g
g
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> h -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize h
h
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> i -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize i
i

instance
  ( Fragmentable a
  , Fragmentable b
  , Fragmentable c
  , Fragmentable d
  , Fragmentable e
  , Fragmentable f
  , Fragmentable g
  , Fragmentable h
  , Fragmentable i
  , Fragmentable j
  )
  => Fragmentable (a, b, c, d, e, f, g, h, i, j)
  where
  fragmentize :: (a, b, c, d, e, f, g, h, i, j) -> Set Fragment
fragmentize (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) =
    (a, b, c, d, e, f, g, h, i, j) -> Set Fragment
forall a. IsFragment a => a -> Set Fragment
singleton (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> a -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize a
a
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> b -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize b
b
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> c -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize c
c
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> d -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize d
d
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> e -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize e
e
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> f -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize f
f
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> g -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize g
g
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> h -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize h
h
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> i -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize i
i
      Set Fragment -> Set Fragment -> Set Fragment
forall a. Semigroup a => a -> a -> a
<> j -> Set Fragment
forall a. Fragmentable a => a -> Set Fragment
fragmentize j
j