{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MonoLocalBinds        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

-- | Simple interface to the anonymous records library
--
-- This module defines a type @Record r@ such that, for example,
--
-- > Record '[ '("a", Bool), '("b", Char) ]
--
-- is the type of records with two fields @a@ and @b@, of types @Bool@ and
-- @Char@ respectively. The difference between the simple interface and the
-- advanced interface is that the advanced interface defines a type
--
-- > Record f '[ '("a", Bool), '("b", Char) ]
--
-- In this case, fields @a@ and @b@ have type @f Bool@ and @f Char@ instead.
-- See "Data.Record.Anonymous.Advanced" for details.
--
-- NOTE: We do not offer a set of combinators in the simple interface, as these
-- are not likely to be very useful. In the rare cases that they are needed,
-- users should use 'toAdvanced'/'fromAdvanced' to temporary use the advanced
-- API for these operations.
--
-- This module is intended for qualified import.
--
-- > import Data.Record.Anonymous.Simple (Record)
-- > import qualified Data.Record.Anonymous.Simple as Anon
module Data.Record.Anon.Internal.Simple (
    Record -- opaque
    -- * Basic API
  , Field -- opaque
  , empty
  , insert
  , insertA
  , get
  , set
  , merge
  , lens
  , project
  , inject
  , applyPending
    -- * Constraints
  , RecordConstraints
    -- * Interop with the advanced interface
  , toAdvanced
  , fromAdvanced
  , sequenceA
    -- * Support for @typelet@
  , letRecordT
  , letInsertAs
  ) where

import Prelude hiding (sequenceA)

import Control.DeepSeq (NFData(..))
import Data.Aeson (ToJSON(..), FromJSON(..))
import Data.Bifunctor
import Data.Record.Generic
import Data.Record.Generic.Eq
import Data.Record.Generic.JSON
import Data.Record.Generic.NFData
import Data.Record.Generic.Show
import Data.Tagged
import GHC.Exts (Any)
import GHC.OverloadedLabels
import GHC.TypeLits
import TypeLet
import Data.Primitive.SmallArray

import qualified GHC.Records        as Base
import qualified GHC.Records.Compat as RecordHasfield
import qualified Optics.Core        as Optics

import Data.Record.Anon.Plugin.Internal.Runtime

import Data.Record.Anon.Internal.Advanced (Field(..))

import qualified Data.Record.Anon.Internal.Advanced as A

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Anonymous record
--
-- A @Record r@ has a field @n@ of type @x@ for every @(n := x)@ in @r@.
--
-- To construct a 'Record', use 'Data.Record.Anon.Simple.insert' and
-- 'Data.Record.Anon.Simple.empty', or use the @ANON@ syntax. See
-- 'Data.Record.Anon.Simple.insert' for examples.
--
-- To access fields of the record, either use the 'GHC.Records.Compat.HasField'
-- instances (possibly using the @record-dot-preprocessor@), or using
-- 'Data.Record.Anon.Simple.get' and 'Data.Record.Anon.Simple.set'.
--
-- Remember to enable the plugin when working with anonymous records:
--
-- > {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-}
--
-- NOTE: For some applications it is useful to have an additional functor
-- parameter @f@, so that every field has type @f x@ instead.
-- See "Data.Record.Anon.Advanced".
newtype Record r = SimpleRecord (A.Record I r)

toAdvanced :: Record r -> A.Record I r
toAdvanced :: forall (r :: Row (*)). Record r -> Record I r
toAdvanced (SimpleRecord Record I r
r) = Record I r
r

{-------------------------------------------------------------------------------
  Interop with advanced API
-------------------------------------------------------------------------------}

fromAdvanced :: A.Record I r -> Record r
fromAdvanced :: forall (r :: Row (*)). Record I r -> Record r
fromAdvanced = forall (r :: Row (*)). Record I r -> Record r
SimpleRecord

sequenceA :: Applicative m => A.Record m r -> m (Record r)
sequenceA :: forall (m :: * -> *) (r :: Row (*)).
Applicative m =>
Record m r -> m (Record r)
sequenceA = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (r :: Row (*)).
Applicative m =>
Record m r -> m (Record I r)
A.sequenceA'

{-------------------------------------------------------------------------------
  Basic API
-------------------------------------------------------------------------------}

empty :: Record '[]
empty :: Record '[]
empty = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *). Record f '[]
A.empty

insert :: Field n -> a -> Record r -> Record (n := a : r)
insert :: forall (n :: Symbol) a (r :: Row (*)).
Field n -> a -> Record r -> Record ((n ':= a) : r)
insert Field n
n a
x = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: k -> *) (r :: Row k) (a :: k) (n :: Symbol).
Field n -> f a -> Record f r -> Record f ((n ':= a) : r)
A.insert Field n
n (forall a. a -> I a
I a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced

insertA ::
     Applicative m
  => Field n -> m a -> m (Record r) -> m (Record (n := a : r))
insertA :: forall (m :: * -> *) (n :: Symbol) a (r :: Row (*)).
Applicative m =>
Field n -> m a -> m (Record r) -> m (Record ((n ':= a) : r))
insertA Field n
f m a
x m (Record r)
r = forall (n :: Symbol) a (r :: Row (*)).
Field n -> a -> Record r -> Record ((n ':= a) : r)
insert Field n
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Record r)
r

merge :: Record r -> Record r' -> Record (Merge r r')
merge :: forall (r :: Row (*)) (r' :: Row (*)).
Record r -> Record r' -> Record (Merge r r')
merge Record r
r Record r'
r' = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (r :: Row k) (r' :: Row k).
Record f r -> Record f r' -> Record f (Merge r r')
A.merge (forall (r :: Row (*)). Record r -> Record I r
toAdvanced Record r
r) (forall (r :: Row (*)). Record r -> Record I r
toAdvanced Record r'
r')

lens :: SubRow r r' => Record r -> (Record r', Record r' -> Record r)
lens :: forall (r :: Row (*)) (r' :: Row (*)).
SubRow r r' =>
Record r -> (Record r', Record r' -> Record r)
lens =
      forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall (r :: Row (*)). Record I r -> Record r
fromAdvanced (\Record I r' -> Record I r
f -> forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record I r' -> Record I r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (r :: Row k) (r' :: Row k).
SubRow r r' =>
Record f r -> (Record f r', Record f r' -> Record f r)
A.lens
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced

project :: SubRow r r' => Record r -> Record r'
project :: forall (r :: Row (*)) (r' :: Row (*)).
SubRow r r' =>
Record r -> Record r'
project = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)) (r' :: Row (*)).
SubRow r r' =>
Record r -> (Record r', Record r' -> Record r)
lens

inject :: SubRow r r' => Record r' -> Record r -> Record r
inject :: forall (r :: Row (*)) (r' :: Row (*)).
SubRow r r' =>
Record r' -> Record r -> Record r
inject Record r'
small = (forall a b. (a -> b) -> a -> b
$ Record r'
small) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)) (r' :: Row (*)).
SubRow r r' =>
Record r -> (Record r', Record r' -> Record r)
lens

applyPending :: Record r -> Record r
applyPending :: forall (r :: Row (*)). Record r -> Record r
applyPending = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (r :: Row k). Record f r -> Record f r
A.applyPending forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced

{-------------------------------------------------------------------------------
  HasField
-------------------------------------------------------------------------------}

instance RecordHasfield.HasField  n            (A.Record I r) (I a)
      => RecordHasfield.HasField (n :: Symbol) (  Record   r)    a where
  hasField :: Record r -> (a -> Record r, a)
hasField = (I a -> Record I r, I a) -> (a -> Record r, a)
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (x :: k) r a. HasField x r a => r -> (a -> r, a)
RecordHasfield.hasField @n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced
    where
      aux :: (I a -> A.Record I r, I a) -> (a -> Record r, a)
      aux :: (I a -> Record I r, I a) -> (a -> Record r, a)
aux (I a -> Record I r
setX, I a
x) = (forall (r :: Row (*)). Record I r -> Record r
fromAdvanced forall b c a. (b -> c) -> (a -> b) -> a -> c
. I a -> Record I r
setX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> I a
I, forall a. I a -> a
unI I a
x)

instance Optics.LabelOptic n Optics.A_Lens (A.Record I r) (A.Record I r) (I a) (I a)
      => Optics.LabelOptic n Optics.A_Lens (    Record   r) (    Record   r)    a     a where
  labelOptic :: Optic A_Lens NoIx (Record r) (Record r) a a
labelOptic = Iso' (Record r) (Record I r)
isoAdvanced forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
Optics.% forall (x :: Symbol) a. IsLabel x a => a
fromLabel @n forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
Optics.% Iso' (I a) a
fromI
    where
      isoAdvanced :: Optics.Iso' (Record r) (A.Record I r)
      isoAdvanced :: Iso' (Record r) (Record I r)
isoAdvanced = forall s a t b. (Coercible s a, Coercible t b) => Iso s t a b
Optics.coerced

      fromI :: Optics.Iso' (I a) a
      fromI :: Iso' (I a) a
fromI = forall s a t b. (Coercible s a, Coercible t b) => Iso s t a b
Optics.coerced

-- | Get field from the record
--
-- This is just a wrapper around 'getField'.
get :: forall n r a. RowHasField n r a => Field n -> Record r -> a
get :: forall (n :: Symbol) (r :: Row (*)) a.
RowHasField n r a =>
Field n -> Record r -> a
get (Field Proxy n
_) = forall {k} (x :: k) r a. HasField x r a => r -> a
RecordHasfield.getField @n @(Record r)

-- | Update field in the record
--
-- This is just a wrapper around 'setField'.
set :: forall n r a. RowHasField n r a => Field n -> a -> Record r -> Record r
set :: forall (n :: Symbol) (r :: Row (*)) a.
RowHasField n r a =>
Field n -> a -> Record r -> Record r
set (Field Proxy n
_) = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall {k} (x :: k) r a. HasField x r a => r -> a -> r
RecordHasfield.setField @n @(Record r))

{-------------------------------------------------------------------------------
  Compatibility with HasField from base
-------------------------------------------------------------------------------}

instance RecordHasfield.HasField  n            (A.Record I r) (I a)
      => Base.HasField           (n :: Symbol) (  Record   r)    a where
  getField :: Record r -> a
getField = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (x :: k) r a. HasField x r a => r -> (a -> r, a)
RecordHasfield.hasField @n

{-------------------------------------------------------------------------------
  Constraints
-------------------------------------------------------------------------------}

class    (AllFields r c, KnownFields r) => RecordConstraints r c
instance (AllFields r c, KnownFields r) => RecordConstraints r c

{-------------------------------------------------------------------------------
  Generics

  We define 'dict' and 'metadata' directly rather than going through the
  instance for 'A.Record'; we /could/ do that, but it's hassle and doesn't
  really buy us anything.
-------------------------------------------------------------------------------}

recordConstraints :: forall r c.
     RecordConstraints r c
  => Proxy c -> Rep (Dict c) (Record r)
recordConstraints :: forall (r :: Row (*)) (c :: * -> Constraint).
RecordConstraints r c =>
Proxy c -> Rep (Dict c) (Record r)
recordConstraints Proxy c
_ = forall (f :: * -> *) a. SmallArray (f Any) -> Rep f a
Rep forall a b. (a -> b) -> a -> b
$
    DictAny c -> Dict c Any
aux forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (s :: k) a (proxy :: k -> *). Tagged s a -> proxy s -> a
proxy forall k (r :: Row k) (c :: k -> Constraint).
AllFields r c =>
DictAllFields k r c
fieldDicts (forall {k} (t :: k). Proxy t
Proxy @r)
  where
    aux :: DictAny c -> Dict c Any
    aux :: DictAny c -> Dict c Any
aux DictAny c
DictAny = forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

instance KnownFields r => Generic (Record r) where
  type Constraints (Record r) = RecordConstraints r
  type MetadataOf  (Record r) = SimpleFieldTypes r

  from :: Record r -> Rep I (Record r)
from     = forall (r :: Row (*)). Rep I (Record I r) -> Rep I (Record r)
fromAdvancedRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Generic a => a -> Rep I a
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Record r -> Record I r
toAdvanced
  to :: Rep I (Record r) -> Record r
to       = forall (r :: Row (*)). Record I r -> Record r
fromAdvanced    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Generic a => Rep I a -> a
to   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: Row (*)). Rep I (Record r) -> Rep I (Record I r)
toAdvancedRep
  dict :: forall (c :: * -> Constraint).
Constraints (Record r) c =>
Proxy c -> Rep (Dict c) (Record r)
dict     = forall (r :: Row (*)) (c :: * -> Constraint).
RecordConstraints r c =>
Proxy c -> Rep (Dict c) (Record r)
recordConstraints
  metadata :: forall (proxy :: * -> *). proxy (Record r) -> Metadata (Record r)
metadata = forall a b. a -> b -> a
const forall (r :: Row (*)). KnownFields r => Metadata (Record r)
recordMetadata

fromAdvancedRep :: Rep I (A.Record I r) -> Rep I (Record r)
fromAdvancedRep :: forall (r :: Row (*)). Rep I (Record I r) -> Rep I (Record r)
fromAdvancedRep = forall a b. a -> b
noInlineUnsafeCo

toAdvancedRep :: Rep I (Record r) -> Rep I (A.Record I r)
toAdvancedRep :: forall (r :: Row (*)). Rep I (Record r) -> Rep I (Record I r)
toAdvancedRep = forall a b. a -> b
noInlineUnsafeCo

recordMetadata :: forall r. KnownFields r => Metadata (Record r)
recordMetadata :: forall (r :: Row (*)). KnownFields r => Metadata (Record r)
recordMetadata = Metadata {
      recordName :: String
recordName          = String
"Record"
    , recordConstructor :: String
recordConstructor   = String
"ANON"
    , recordSize :: Int
recordSize          = forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldMetadata Any]
fields
    , recordFieldMetadata :: Rep FieldMetadata (Record r)
recordFieldMetadata = forall (f :: * -> *) a. SmallArray (f Any) -> Rep f a
Rep forall a b. (a -> b) -> a -> b
$ forall a. [a] -> SmallArray a
smallArrayFromList [FieldMetadata Any]
fields
    }
  where
    fields :: [FieldMetadata Any]
    fields :: [FieldMetadata Any]
fields = forall k (r :: Row k) (proxy :: Row k -> *).
KnownFields r =>
proxy r -> [FieldMetadata Any]
fieldMetadata (forall {k} (t :: k). Proxy t
Proxy @r)

{-------------------------------------------------------------------------------
  Instances

  As for the generic instances, we make no attempt to go through the advanced
  API here, as it's painful for little benefit.
-------------------------------------------------------------------------------}

instance RecordConstraints r Show => Show (Record r) where
  showsPrec :: Int -> Record r -> ShowS
showsPrec = forall a. (Generic a, Constraints a Show) => Int -> a -> ShowS
gshowsPrec

instance RecordConstraints r Eq => Eq (Record r) where
  == :: Record r -> Record r -> Bool
(==) = forall a. (Generic a, Constraints a Eq) => a -> a -> Bool
geq

instance ( RecordConstraints r Eq
         , RecordConstraints r Ord
         ) => Ord (Record r) where
  compare :: Record r -> Record r -> Ordering
compare = forall a. (Generic a, Constraints a Ord) => a -> a -> Ordering
gcompare

instance RecordConstraints r NFData => NFData (Record r) where
  rnf :: Record r -> ()
rnf = forall a. (Generic a, Constraints a NFData) => a -> ()
grnf

instance RecordConstraints r ToJSON => ToJSON (Record r) where
  toJSON :: Record r -> Value
toJSON = forall a. (Generic a, Constraints a ToJSON) => a -> Value
gtoJSON

instance RecordConstraints r FromJSON => FromJSON (Record r) where
  parseJSON :: Value -> Parser (Record r)
parseJSON = forall a. (Generic a, Constraints a FromJSON) => Value -> Parser a
gparseJSON

{-------------------------------------------------------------------------------
  Support for @typelet@
-------------------------------------------------------------------------------}

-- | Introduce type variable for a row
letRecordT :: forall r.
     (forall r'. Let r' r => Proxy r' -> Record r)
  -> Record r
letRecordT :: forall (r :: Row (*)).
(forall (r' :: Row (*)). Let r' r => Proxy r' -> Record r)
-> Record r
letRecordT forall (r' :: Row (*)). Let r' r => Proxy r' -> Record r
f = forall {k} r (a :: k).
Proxy a -> (forall (b :: k). Let b a => Proxy b -> r) -> r
letT' (forall {k} (t :: k). Proxy t
Proxy @r) forall (r' :: Row (*)). Let r' r => Proxy r' -> Record r
f

-- | Insert field into a record and introduce type variable for the result
letInsertAs :: forall r r' n a.
     Proxy r     -- ^ Type of the record we are constructing
  -> Field n     -- ^ New field to be inserted
  -> a           -- ^ Value of the new field
  -> Record r'   -- ^ Record constructed so far
  -> (forall r''. Let r'' (n := a : r') => Record r'' -> Record r)
                 -- ^ Assign type variable to new partial record, and continue
  -> Record r
letInsertAs :: forall (r :: Row (*)) (r' :: Row (*)) (n :: Symbol) a.
Proxy r
-> Field n
-> a
-> Record r'
-> (forall (r'' :: Row (*)).
    Let r'' ((n ':= a) : r') =>
    Record r'' -> Record r)
-> Record r
letInsertAs Proxy r
_ Field n
n a
x Record r'
r = forall {k} r (f :: k -> *) (a :: k).
f a -> (forall (b :: k). Let b a => f b -> r) -> r
letAs' (forall (n :: Symbol) a (r :: Row (*)).
Field n -> a -> Record r -> Record ((n ':= a) : r)
insert Field n
n a
x Record r'
r)