module Data.Ruin.Internal (module Data.Ruin.Internal) where
import Data.Functor.Compose
import Data.Functor.Identity
import Data.Proxy (Proxy(..))
import Data.Type.Bool (If)
import GHC.OverloadedLabels
import GHC.TypeLits
import Data.Ruin.Eval
import Data.Ruin.Hoid (Hoid)
runCEI :: Compose Eval Identity a -> a
runCEI = runIdentity . runEval . getCompose
proxyOf :: a -> Proxy a
proxyOf = const Proxy
data Label (s :: Symbol) = MkLabel
mkLabel :: forall s. Label s
mkLabel = MkLabel
instance (s1 ~ s2) => IsLabel s1 (Label s2) where fromLabel _ = MkLabel
type Labels fs = Labels_ '[] -> Labels_ fs
data Labels_ (s :: [Symbol]) = MkLabels_
consLabels :: forall s ss. Labels_ ss -> Labels_ (s ': ss)
consLabels _ = MkLabels_
mkLabels :: forall fs. Labels fs
mkLabels _ = MkLabels_
nilLabels :: Labels_ '[]
nilLabels = MkLabels_
instance (cod ~ Labels_ (s ': ss)) => IsLabel s (Labels_ ss -> cod) where fromLabel = \_ -> consLabels
type family Difference (xs :: [k]) (ys :: [k]) :: [k] where
Difference '[] ys = '[]
Difference (x ': xs) ys =
If (Elem x ys)
(Difference xs ys)
(x ': Difference xs ys)
type family Intersection (xs :: [k]) (ys :: [k]) :: [k] where
Intersection '[] ys = '[]
Intersection (x ': xs) ys =
If (Elem x ys)
(x ': Intersection xs ys)
(Intersection xs ys)
type family Elem (t :: k) (ts :: [k]) :: Bool where
Elem t '[] = 'False
Elem t (t ': ts) = 'True
Elem t (t2 ': ts) = Elem t ts
type family (xs :: [k]) ++ (ys :: [k]) :: [k] where
'[] ++ ys = ys
(x ': xs) ++ ys = x ': xs ++ ys
type family MapFst (ps :: [(a,b)]) :: [a] where
MapFst '[] = '[]
MapFst ( '(a,b) ': ps ) = a ': MapFst ps
type family MapSecondConst (c :: b) (ps :: [(a,b)]) :: [(a,b)] where
MapSecondConst _ '[] = '[]
MapSecondConst c ( '(a,_) ': ps ) = '(a,c) ': MapSecondConst c ps
type family Head (xs :: [a]) :: a where Head (a ': _) = a
type family Tail (xs :: [a]) :: [a] where Tail (_ ': as) = as
type family Fst (p :: (a,b)) :: a where Fst '(a,_) = a
type family Snd (p :: (a,b)) :: b where Snd '(_,b) = b
type family HalfLength (x :: [a]) :: Nat where
HalfLength (_ ': _ ': xs) = 1 + HalfLength xs
HalfLength _ = 0
type family Take (n :: Nat) (xs :: [a]) :: [a] where
Take 0 _ = '[]
Take n (x ': xs) = x ': Take (n1) xs
type family Drop (n :: Nat) (xs :: [a]) :: [a] where
Drop 0 xs = xs
Drop n (_ ': xs) = Drop (n1) xs
type FirstHalf xs = Take (HalfLength xs) xs
type SecondHalf xs = Drop (HalfLength xs) xs
type family DifferenceByFst (xs :: [(k,v)]) (ys :: [k]) :: [(k,v)] where
DifferenceByFst '[] ys = '[]
DifferenceByFst (x ': xs) ys =
If (Elem (Fst x) ys)
(DifferenceByFst xs ys)
(x ': DifferenceByFst xs ys)
class NoWarnUnusedTopBind t where
noWarnUnusedTopBind :: Hoid t a => a -> ()
data Tup1 a = MkTup1 a deriving Show