{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Lens.Barlow.Classes where

import Data.Data (Proxy (..))
import Data.Lens.Barlow.Parser (Parse)
import Data.Lens.Barlow.Types
import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, symbolVal)
import GHC.TypeNats (natVal)

class KnownTag (a :: Tag) where
  tagVal :: TagVal

instance KnownTag Tag'QuestionMark where tagVal :: TagVal
tagVal = TagVal
TagVal'QuestionMark
instance KnownTag Tag'RightArrow where tagVal :: TagVal
tagVal = TagVal
TagVal'RightArrow
instance KnownTag Tag'LeftArrow where tagVal :: TagVal
tagVal = TagVal
TagVal'LeftArrow
instance KnownTag Tag'Plus where tagVal :: TagVal
tagVal = TagVal
TagVal'Plus
instance KnownTag Tag'ExclamationMark where tagVal :: TagVal
tagVal = TagVal
TagVal'ExclamationMark
instance (KnownSymbol a) => KnownTag (Tag'PercentageName a) where tagVal :: TagVal
tagVal = String -> TagVal
TagVal'PercentageName (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @a))
instance (KnownNat a) => KnownTag (Tag'PercentageNumber a) where tagVal :: TagVal
tagVal = Nat -> TagVal
TagVal'PercentageNumber (forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall {k} (t :: k). Proxy t
Proxy @a))
instance (KnownSymbol a) => KnownTag (Tag'Name a) where tagVal :: TagVal
tagVal = String -> TagVal
TagVal'Name (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @a))

class KnownTags (a :: [Tag]) where
  tagVals :: [TagVal]

instance KnownTags '[] where
  tagVals :: [TagVal]
tagVals = []

instance (KnownTag x, KnownTags xs) => KnownTags (x : xs) where
  tagVals :: [TagVal]
tagVals = (forall (a :: Tag). KnownTag a => TagVal
tagVal @x) forall a. a -> [a] -> [a]
: forall (a :: [Tag]). KnownTags a => [TagVal]
tagVals @xs

class KnownSymbolTags (s :: Symbol) where
  symbolTagVals :: [TagVal]

instance (KnownTags (Parse s)) => KnownSymbolTags s where
  symbolTagVals :: [TagVal]
symbolTagVals = forall (a :: [Tag]). KnownTags a => [TagVal]
tagVals @(Parse s)