    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}

    {-|

    This is an __experimental__ module that introduces support for dynamic
    values: these are functions from a record @model@ to some type @a@
    which keep track of which selectors of @model@ does the result depend
    on. For example, for a record of the form

    > data Example = Example {
    >     first  :: Int,
    >     second :: Bool,
    >     third  :: Float
    > }

    a `DynVal Example String` could be constructed, assuming that you are
    given a @record@ `DynVal` representing the full record, using:

    > let format = \f s -> "First is " <> f <> " and second is " <> s
    >     formatted = format <$> record.first <*> record.second :: DynVal Example String

    Here we are showcasing two properties of `DynVal`s: they can be
    conveniently constructed using @OverloadedRecordDot@, and they provide
    an `Applicative` instance. The resulting @formatted@ `DynVal` keeps
    track of the fact that it depends on the @first@ and @second@ record
    selectors.

    -}

    module Data.GI.Base.DynVal
      ( DynVal(..), DVKey(..), ModelProxy(..), dvKeys, dvRead,
        modelProxyCurrentValue, modelProxyRegisterHandler, modelProxyUpdate) where

    import GHC.Records (HasField(..))
    import qualified GHC.TypeLits as TL

    import Data.Proxy (Proxy(..))
    import qualified Data.Set as S
    import Data.String (IsString(..))
    import qualified Data.Text as T

    data DVKey = DVKeyDirect [T.Text]
                 -- ^ Direct access to subfields: for example writing
                 -- @record.field.subfield@ (using the `HasField`
                 -- instance) would lead to @`DVKeyDirect` ["field",
                 -- "subfield"]@
               | DVKeyDerived (S.Set [T.Text])
                 -- ^ Value derived from a direct key, by acting with the
                 -- functor or applicative instances.
      deriving (DVKey -> DVKey -> Bool
    (DVKey -> DVKey -> Bool) -> (DVKey -> DVKey -> Bool) -> Eq DVKey
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DVKey -> DVKey -> Bool
    == :: DVKey -> DVKey -> Bool
    $c/= :: DVKey -> DVKey -> Bool
    /= :: DVKey -> DVKey -> Bool
    Eq, Eq DVKey
    Eq DVKey =>
    (DVKey -> DVKey -> Ordering)
    -> (DVKey -> DVKey -> Bool)
    -> (DVKey -> DVKey -> Bool)
    -> (DVKey -> DVKey -> Bool)
    -> (DVKey -> DVKey -> Bool)
    -> (DVKey -> DVKey -> DVKey)
    -> (DVKey -> DVKey -> DVKey)
    -> Ord DVKey
    DVKey -> DVKey -> Bool
    DVKey -> DVKey -> Ordering
    DVKey -> DVKey -> DVKey
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: DVKey -> DVKey -> Ordering
    compare :: DVKey -> DVKey -> Ordering
    $c< :: DVKey -> DVKey -> Bool
    < :: DVKey -> DVKey -> Bool
    $c<= :: DVKey -> DVKey -> Bool
    <= :: DVKey -> DVKey -> Bool
    $c> :: DVKey -> DVKey -> Bool
    > :: DVKey -> DVKey -> Bool
    $c>= :: DVKey -> DVKey -> Bool
    >= :: DVKey -> DVKey -> Bool
    $cmax :: DVKey -> DVKey -> DVKey
    max :: DVKey -> DVKey -> DVKey
    $cmin :: DVKey -> DVKey -> DVKey
    min :: DVKey -> DVKey -> DVKey
    Ord, Int -> DVKey -> ShowS
    [DVKey] -> ShowS
    DVKey -> String
    (Int -> DVKey -> ShowS)
    -> (DVKey -> String) -> ([DVKey] -> ShowS) -> Show DVKey
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DVKey -> ShowS
    showsPrec :: Int -> DVKey -> ShowS
    $cshow :: DVKey -> String
    show :: DVKey -> String
    $cshowList :: [DVKey] -> ShowS
    showList :: [DVKey] -> ShowS
    Show)

    -- | A `DynVal` is a way of extracting values of type @a@ from
    -- @model@, which keeps track of which fields (parameterised by
    -- `dvKeys`) in @model@ are needed for computing the `DynVal`.
    data DynVal model a = DynVal DVKey (model -> a)

    -- | Keys to fields in the model that this `DynVal` depends on.
    dvKeys :: DynVal model a -> DVKey
    dvKeys :: forall model a. DynVal model a -> DVKey
    dvKeys (DynVal DVKey
    s model -> a
    _) = DVKey
    s

    -- | Compute the actual value given a model.
    dvRead :: DynVal model a -> model -> a
    dvRead :: forall model a. DynVal model a -> model -> a
    dvRead (DynVal DVKey
    _ model -> a
    r) = model -> a
    r

    -- | Turn a key into a derived one.
    toDerived :: DVKey -> DVKey
    toDerived :: DVKey -> DVKey
    toDerived (DVKeyDirect [Text]
    d) = Set [Text] -> DVKey
    DVKeyDerived ([Text] -> Set [Text]
    forall a. a -> Set a
    S.singleton [Text]
    d)
    toDerived DVKey
    derived = DVKey
    derived

    -- | Joining of keys always produces derived ones.
    instance Semigroup DVKey where
      DVKeyDirect [Text]
    a <> :: DVKey -> DVKey -> DVKey
    <> DVKeyDirect [Text]
    b = Set [Text] -> DVKey
    DVKeyDerived (Set [Text] -> DVKey) -> Set [Text] -> DVKey
    forall a b. (a -> b) -> a -> b
    $ [[Text]] -> Set [Text]
    forall a. Ord a => [a] -> Set a
    S.fromList [[Text]
    a,[Text]
    b]
      (DVKeyDirect [Text]
    a) <> (DVKeyDerived Set [Text]
    b) =
        Set [Text] -> DVKey
    DVKeyDerived (Set [Text] -> DVKey) -> Set [Text] -> DVKey
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Set [Text] -> Set [Text]
    forall a. Ord a => a -> Set a -> Set a
    S.insert [Text]
    a Set [Text]
    b
      (DVKeyDerived Set [Text]
    a) <> (DVKeyDirect [Text]
    b) =
        Set [Text] -> DVKey
    DVKeyDerived (Set [Text] -> DVKey) -> Set [Text] -> DVKey
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Set [Text] -> Set [Text]
    forall a. Ord a => a -> Set a -> Set a
    S.insert [Text]
    b Set [Text]
    a
      (DVKeyDerived Set [Text]
    a) <> (DVKeyDerived Set [Text]
    b) =
        Set [Text] -> DVKey
    DVKeyDerived (Set [Text] -> DVKey) -> Set [Text] -> DVKey
    forall a b. (a -> b) -> a -> b
    $ Set [Text] -> Set [Text] -> Set [Text]
    forall a. Ord a => Set a -> Set a -> Set a
    S.union Set [Text]
    a Set [Text]
    b

    instance Functor (DynVal model) where
      fmap :: forall a b. (a -> b) -> DynVal model a -> DynVal model b
    fmap a -> b
    f DynVal model a
    dv = DVKey -> (model -> b) -> DynVal model b
    forall model a. DVKey -> (model -> a) -> DynVal model a
    DynVal (DVKey -> DVKey
    toDerived (DVKey -> DVKey) -> DVKey -> DVKey
    forall a b. (a -> b) -> a -> b
    $ DynVal model a -> DVKey
    forall model a. DynVal model a -> DVKey
    dvKeys DynVal model a
    dv) (a -> b
    f (a -> b) -> (model -> a) -> model -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynVal model a -> model -> a
    forall model a. DynVal model a -> model -> a
    dvRead DynVal model a
    dv)

    instance Applicative (DynVal model) where
      pure :: forall a. a -> DynVal model a
    pure a
    x = DVKey -> (model -> a) -> DynVal model a
    forall model a. DVKey -> (model -> a) -> DynVal model a
    DynVal (Set [Text] -> DVKey
    DVKeyDerived Set [Text]
    forall a. Set a
    S.empty) (a -> model -> a
    forall a b. a -> b -> a
    const a
    x)
      DynVal model (a -> b)
    dF <*> :: forall a b.
    DynVal model (a -> b) -> DynVal model a -> DynVal model b
    <*> DynVal model a
    dA = DVKey -> (model -> b) -> DynVal model b
    forall model a. DVKey -> (model -> a) -> DynVal model a
    DynVal (DynVal model (a -> b) -> DVKey
    forall model a. DynVal model a -> DVKey
    dvKeys DynVal model (a -> b)
    dF DVKey -> DVKey -> DVKey
    forall a. Semigroup a => a -> a -> a
    <> DynVal model a -> DVKey
    forall model a. DynVal model a -> DVKey
    dvKeys DynVal model a
    dA)
                         (\model
    m -> let f :: a -> b
    f = DynVal model (a -> b) -> model -> a -> b
    forall model a. DynVal model a -> model -> a
    dvRead DynVal model (a -> b)
    dF model
    m
                                in a -> b
    f (DynVal model a -> model -> a
    forall model a. DynVal model a -> model -> a
    dvRead DynVal model a
    dA model
    m))

    instance IsString (DynVal model T.Text) where
      fromString :: String -> DynVal model Text
    fromString String
    s = Text -> DynVal model Text
    forall a. a -> DynVal model a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> Text
    T.pack String
    s)

    {-
    -- If we make dvKeys :: model -> S.Set DVKey we can also produce a
    -- Monad instance, but the set of resulting keys might depend on the
    -- specific model passed, which could lead to subtle bugs.

    instance Monad (DynVal model) where
      dv >>= gen = let runGen = \m -> gen (dvRead dv m)
                   in DynVal {dvKeys = \m -> S.union (dvKeys dv m)
                                             (dvKeys (runGen m) m)
                             , dvRead = \m -> dvRead (runGen m) m
                             }
    -}

    -- | A `ModelProxy` is a way of obtaining records of type `model`,
    -- which allows for registering for notifications whenever certain
    -- keys (typically associated to record fields) get modified, and
    -- allows to modify fields of the model.
    data ModelProxy model = ModelProxy (IO model) (DVKey -> (model -> IO ()) -> IO ()) ([T.Text] -> (model -> Maybe model) -> IO ())

    -- The following would be most naturally field accessors, but because
    -- we introduce HasField instances for proxies we need to make these
    -- ordinary functions instead.

    -- | Obtain the current value of the model.
    modelProxyCurrentValue :: ModelProxy model -> IO model
    modelProxyCurrentValue :: forall model. ModelProxy model -> IO model
    modelProxyCurrentValue (ModelProxy IO model
    m DVKey -> (model -> IO ()) -> IO ()
    _ [Text] -> (model -> Maybe model) -> IO ()
    _) = IO model
    m

    -- | Register a handler that will be executed whenever any of the
    -- fields in the model pointed to by the keys is modified.
    modelProxyRegisterHandler :: ModelProxy model -> DVKey -> (model -> IO ()) -> IO ()
    modelProxyRegisterHandler :: forall model.
    ModelProxy model -> DVKey -> (model -> IO ()) -> IO ()
    modelProxyRegisterHandler (ModelProxy IO model
    _ DVKey -> (model -> IO ()) -> IO ()
    r [Text] -> (model -> Maybe model) -> IO ()
    _) = DVKey -> (model -> IO ()) -> IO ()
    r

    -- | Modify the given keys in the proxy, using the given update
    -- function, of type (model -> Maybe model). If this function returns
    -- Nothing no modification will be performed, otherwise the modified
    -- model will be stored in the ModelProxy, and any listeners will be
    -- notified of a change.
    modelProxyUpdate :: ModelProxy model -> [T.Text] -> (model -> Maybe model)
                     -> IO ()
    modelProxyUpdate :: forall model.
    ModelProxy model -> [Text] -> (model -> Maybe model) -> IO ()
    modelProxyUpdate (ModelProxy IO model
    _ DVKey -> (model -> IO ()) -> IO ()
    _ [Text] -> (model -> Maybe model) -> IO ()
    u) = [Text] -> (model -> Maybe model) -> IO ()
    u

    instance (HasField fieldName field a,
              TL.KnownSymbol fieldName) =>
      HasField fieldName (DynVal model field) (DynVal model a) where
      getField :: DynVal model field -> DynVal model a
    getField DynVal model field
    dv = let fn :: Text
    fn = String -> Text
    T.pack (String -> Text)
    -> (Proxy fieldName -> String) -> Proxy fieldName -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Proxy fieldName -> String
    forall (n :: Symbol) (proxy :: Symbol -> *).
    KnownSymbol n =>
    proxy n -> String
    TL.symbolVal (Proxy fieldName -> Text) -> Proxy fieldName -> Text
    forall a b. (a -> b) -> a -> b
    $ (Proxy fieldName
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy fieldName)
                        key :: DVKey
    key = case DynVal model field -> DVKey
    forall model a. DynVal model a -> DVKey
    dvKeys DynVal model field
    dv of
                          derived :: DVKey
    derived@(DVKeyDerived Set [Text]
    _) -> DVKey
    derived
                          DVKeyDirect [Text]
    direct -> [Text] -> DVKey
    DVKeyDirect ([Text]
    direct [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <> [Text
    fn])
                    in DVKey -> (model -> a) -> DynVal model a
    forall model a. DVKey -> (model -> a) -> DynVal model a
    DynVal DVKey
    key (forall {k} (x :: k) r a. HasField x r a => r -> a
    forall (x :: Symbol) r a. HasField x r a => r -> a
    getField @fieldName (field -> a) -> (model -> field) -> model -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynVal model field -> model -> field
    forall model a. DynVal model a -> model -> a
    dvRead DynVal model field
    dv)