{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Barbie.Internal.Classification
( BarbieType(..)
, GClassifyBarbie
, ClassifyBarbie
)
where
import Data.Barbie.Internal.Generics(Target, RecUsage(..), NonRec(..), RecRep, W)
import Data.Barbie.Internal.Tags(F)
import GHC.Generics
data BarbieType
= NoBarbie
| WearBarbie
| NonWearBarbie
| MixedBarbie
type family MergeBarbieType l r where
MergeBarbieType 'NoBarbie r = r
MergeBarbieType l 'NoBarbie = l
MergeBarbieType 'MixedBarbie _ = 'MixedBarbie
MergeBarbieType _ 'MixedBarbie = 'MixedBarbie
MergeBarbieType x x = x
MergeBarbieType _l _r = 'MixedBarbie
type family GClassifyBarbie rep where
GClassifyBarbie (M1 _i _c x) = GClassifyBarbie x
GClassifyBarbie V1 = 'NoBarbie
GClassifyBarbie U1 = 'NoBarbie
GClassifyBarbie (l :*: r) = MergeBarbieType (GClassifyBarbie l) (GClassifyBarbie r)
GClassifyBarbie (l :+: r) = MergeBarbieType (GClassifyBarbie l) (GClassifyBarbie r)
GClassifyBarbie (K1 R (NonRec (Target (W F) a))) = 'WearBarbie
GClassifyBarbie (K1 R (NonRec (Target F a))) = 'NonWearBarbie
GClassifyBarbie (K1 R (NonRec (b (Target F)))) = GClassifyBarbie (Rep (b (Target F)))
GClassifyBarbie (K1 R (RecUsage (b (Target F)))) = 'NoBarbie
GClassifyBarbie (K1 _i _c) = 'NoBarbie
type ClassifyBarbie b = GClassifyBarbie (RecRep (b (Target F)))