{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Utilities for defining your own validity 'Spec's
--
-- You will need @TypeApplications@ to use these.
module Test.Syd.Validity.Utils
  ( nameOf,
    genDescr,
    binRelStr,
    shouldBeValid,
    shouldBeInvalid,
    Anon (..),
  )
where

import Data.Data
import Test.Syd.Validity.Property.Utils

nameOf ::
  forall a.
  Typeable a =>
  String
nameOf :: String
nameOf =
  let s :: String
s = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
   in if Char
' ' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s
        then String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        else String
s

genDescr ::
  forall a.
  Typeable a =>
  String ->
  String
genDescr :: String -> String
genDescr String
genname = [String] -> String
unwords [String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
genname, String
"::", Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""]

binRelStr ::
  forall a.
  Typeable a =>
  String ->
  String
binRelStr :: String -> String
binRelStr String
op = [String] -> String
unwords [String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")", String
"::", String
name, String
"->", String
name, String
"->", String
"Bool"]
  where
    name :: String
name = Typeable a => String
forall k (a :: k). Typeable a => String
nameOf @a

newtype Anon a
  = Anon a

instance Show (Anon a) where
  show :: Anon a -> String
show Anon a
_ = String
"Anonymous"

instance Functor Anon where
  fmap :: (a -> b) -> Anon a -> Anon b
fmap a -> b
f (Anon a
a) = b -> Anon b
forall a. a -> Anon a
Anon (a -> b
f a
a)