{-# LANGUAGE CPP, TypeFamilies, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Extensible.Label
-- Copyright   :  (c) Fumiaki Kinoshita 2018
-- License     :  BSD3
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--
-- Experimental API for OverloadedLabels. GHC 8.0+ only
-----------------------------------------------------------------------------
module Data.Extensible.Label where

import Data.Extensible.Class
import Data.Extensible.Field
import Data.Extensible.Product (hlookup)
import Data.Proxy
import GHC.OverloadedLabels
import GHC.Records
import Data.Extensible.Wrapper

instance k ~ l => IsLabel k (Proxy l) where
#if __GLASGOW_HASKELL__ >= 802
  fromLabel :: Proxy l
fromLabel = Proxy l
forall k (t :: k). Proxy t
Proxy
#else
  fromLabel _ = Proxy
#endif

-- | Specialised version of 'itemAssoc'.
訊 :: Proxy k -> FieldOptic k
訊 :: Proxy k -> FieldOptic k
訊 = Proxy k
-> p (Repr h v) (f (Repr h v))
-> p (t xs (Field h)) (f (t xs (Field h)))
forall k1 v1 (h :: Assoc k1 v1 -> *) (f :: * -> *)
       (p :: * -> * -> *) (t :: [Assoc k1 v1] -> (Assoc k1 v1 -> *) -> *)
       (xs :: [Assoc k1 v1]) (k2 :: k1) (v2 :: v1) (proxy :: k1 -> *).
(Wrapper h, Extensible f p t, Lookup xs k2 v2,
 ExtensibleConstr t xs h (k2 ':> v2)) =>
proxy k2 -> Optic' p f (t xs h) (Repr h (k2 ':> v2))
itemAssoc
{-# DEPRECATED 訊 "Use xlb instead" #-}

-- | Specialised version of 'itemAssoc'. Stands for "eXtensible LaBel"
xlb :: Proxy k -> FieldOptic k
xlb :: Proxy k -> FieldOptic k
xlb = Proxy k
-> p (Repr h v) (f (Repr h v))
-> p (t xs (Field h)) (f (t xs (Field h)))
forall k1 v1 (h :: Assoc k1 v1 -> *) (f :: * -> *)
       (p :: * -> * -> *) (t :: [Assoc k1 v1] -> (Assoc k1 v1 -> *) -> *)
       (xs :: [Assoc k1 v1]) (k2 :: k1) (v2 :: v1) (proxy :: k1 -> *).
(Wrapper h, Extensible f p t, Lookup xs k2 v2,
 ExtensibleConstr t xs h (k2 ':> v2)) =>
proxy k2 -> Optic' p f (t xs h) (Repr h (k2 ':> v2))
itemAssoc

instance (Extensible f p e
  , Lookup xs k v
  , Labelling k p
  , Wrapper h
  , ExtensibleConstr e xs (Field h) (k ':> v)
  , rep ~ Repr h v
  , s ~ e xs (Field h)
  , s ~ t
  , rep ~ rep'
  )
  => IsLabel k (p rep (f rep') -> p s (f t)) where
#if __GLASGOW_HASKELL__ >= 802
  fromLabel :: p rep (f rep') -> p s (f t)
fromLabel = Proxy k -> Optic' p f (e xs (Field h)) (Repr (Field h) (k ':> v))
forall k1 v1 (h :: Assoc k1 v1 -> *) (f :: * -> *)
       (p :: * -> * -> *) (t :: [Assoc k1 v1] -> (Assoc k1 v1 -> *) -> *)
       (xs :: [Assoc k1 v1]) (k2 :: k1) (v2 :: v1) (proxy :: k1 -> *).
(Wrapper h, Extensible f p t, Lookup xs k2 v2,
 ExtensibleConstr t xs h (k2 ':> v2)) =>
proxy k2 -> Optic' p f (t xs h) (Repr h (k2 ':> v2))
itemAssoc (Proxy k
forall k (t :: k). Proxy t
Proxy :: Proxy k)
#else
  fromLabel _ = itemAssoc (Proxy :: Proxy k)
#endif

instance (Lookup xs k v, Wrapper h, Repr h v ~ a) => HasField k (RecordOf h xs) a where
  getField :: RecordOf h xs -> a
getField = Field h (k >: v) -> a
forall k (h :: k -> *) (v :: k). Wrapper h => h v -> Repr h v
unwrap (Field h (k >: v) -> a)
-> (RecordOf h xs -> Field h (k >: v)) -> RecordOf h xs -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Membership xs (k >: v) -> RecordOf h xs -> Field h (k >: v)
forall k (xs :: [k]) (x :: k) (h :: k -> *).
Membership xs x -> (xs :& h) -> h x
hlookup (Membership xs (k >: v)
forall k k1 (xs :: [Assoc k k1]) (k2 :: k) (v :: k1).
Lookup xs k2 v =>
Membership xs (k2 ':> v)
association :: Membership xs (k >: v))