Fix shadowed name warning

Fix shadowed name warning

module Halogen.Query.EventSource where

import Prelude

import Control.Coroutine as CR
import Control.Monad.Aff (Aff, attempt, launchAff_)
import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Aff.AVar as AV
import Control.Monad.Aff.Class (class MonadAff, liftAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception as Exn
import Control.Monad.Free.Trans as FT
import Control.Monad.Trans.Class (lift)
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Monoid (class Monoid)
import Data.Profunctor (dimap)

-- | An event source definition - an effect in `m` that when run returns a
-- | producer coroutine that emits queries of type `f`, and runs in the effect
-- | monad `m`.
-- |
-- | It's generally unnecessary to build values of this type directly with this
-- | constructor, the `affEventSource` and `effEventSource` cover the most
-- | event source constructions.
newtype EventSource m f = EventSource (m { producer :: CR.Producer (f Unit) m Unit, finalizer :: Finalizer m })

-- | Constructs an event source from a setup function that operates in `Aff`.
-- |
-- | - The `Emitter` that the passed function receives is used to `emit` queries
-- |   that will be received by the current component, or can be `close`d to
-- |   shut down the event source and remove the subscription.
-- | - The `Finalizer` that the passed function produces is there to allow for
-- |   some clean-up action to be taken when the event source is unsubscribed
-- |   from. This also runs if the `Emitter` is `close`d. `mempty` can be used
-- |   here if there is no clean-up to perform.
affEventSource
  :: forall m f eff
   . MonadAff (avar :: AVAR | eff) m
  => (Emitter (Aff (avar :: AVAR | eff)) f -> Aff (avar :: AVAR | eff) (Finalizer (Aff (avar :: AVAR | eff))))
  -> EventSource m f
affEventSource recv = EventSource $ liftAff do
  inputVar <- AV.makeEmptyVar
  finalizeVar <- AV.makeEmptyVar
  let
    producer = do
      lift $ liftAff $ flip AV.putVar finalizeVar =<< recv (Emitter (flip AV.putVar inputVar))
      CR.producer $ liftAff $ AV.takeVar inputVar
    finalizer = Finalizer do
      liftAff (attempt (AV.takeVar finalizeVar)) >>= case _ of
        Left _ -> pure unit
        Right z -> liftAff do
          AV.killVar (Exn.error "finalized") finalizeVar
          finalize z
  pure { producer, finalizer }

-- | Constructs an event source from a setup function that operates in `Eff`.
-- |
-- | - The `Emitter` that the passed function receives is used to `emit` queries
-- |   that will be received by the current component, or can be `close`d to
-- |   shut down the event source and remove the subscription.
-- | - The `Finalizer` that the passed function produces is there to allow for
-- |   some clean-up action to be taken when the event source is unsubscribed
-- |   from. This also runs if the `Emitter` is `close`d. `mempty` can be used
-- |   here if there is no clean-up to perform.
effEventSource
  :: forall m f eff
   . MonadAff (avar :: AVAR | eff) m
  => (Emitter (Eff (avar :: AVAR | eff)) f -> Eff (avar :: AVAR | eff) (Finalizer (Eff (avar :: AVAR | eff))))
  -> EventSource m f
effEventSource =
  affEventSource <<<
    dimap (hoistEmitter launchAff_) (liftEff <<< map (hoistFinalizer liftEff))

-- | Changes the query component of an event source.
interpret :: forall m f g. Functor m => (f ~> g) -> EventSource m f -> EventSource m g
interpret f (EventSource es) =
  EventSource $
    map
      (\e -> { producer: FT.interpret (lmap f) e.producer, finalizer: e.finalizer })
      es

-- | Changes the effect monad component of an event source.
hoist :: forall m n f. Functor n => (m ~> n) -> EventSource m f -> EventSource n f
hoist nat (EventSource es) =
  EventSource $
    map
      (\e -> { producer: FT.hoistFreeT nat e.producer, finalizer: hoistFinalizer nat e.finalizer })
      (nat es)

-- | Values of this type are created internally by `affEventSource` and
-- | `effEventSource`, and then passed into the user-provided setup function.
-- |
-- | This type is just a wrapper around a callback, used to simplify the type
-- | signatures for setting up event sources.
newtype Emitter m f = Emitter (Either (f Unit) Unit -> m Unit)

-- | Emits an "action style" query via the emitter. Accepts a partially applied
-- | query constructor to save having to use `H.action` or applying `unit` when
-- | constructing the query, for example:
-- |
-- | ``` purescript
-- | data Query a = Notify String a
-- |
-- | myEventSource = EventSource.affEventSource \emitter -> do
-- |   Aff.delay (Milliseconds 1000.0)
-- |   EventSource.emit emitter (Notify "hello")
-- |   pure mempty
-- | ```
emit :: forall m f. Emitter m f -> (Unit -> f Unit) -> m Unit
emit (Emitter f) q = f (Left (q unit))

-- | Closes the emitter, shutting down the event source. This allows an event
-- | source to stop itself internally, rather than requiring external shutdown
-- | by unsubscribing from it.
-- |
-- | The event source will automatically be unsubscribed from when this is
-- | called, and the finalizer returned during event source setup will be
-- | executed.
-- |
-- | Any further calls to `emit` after `close` will be ignored.
close :: forall m a. Emitter m a -> m Unit
close (Emitter f) = f (Right unit)

-- | Changes the effect monad for an emitter.
hoistEmitter :: forall m n f. (m Unit -> n Unit) -> Emitter m f -> Emitter n f
hoistEmitter nat (Emitter f) = Emitter (nat <<< f)

-- | When setting up an event source, values of this type should be returned to
-- | describe any clean-up operations required. This is just a newtype around
-- | an effectful operation, but helps with type signature comprehension.
-- |
-- | There is a `Monoid` instance provided for finalizers, so `mempty` can be
-- | used in cases where there are no relevant clean-up actions to take.
newtype Finalizer m = Finalizer (m Unit)

instance semigroupFinalizer :: Apply m => Semigroup (Finalizer m) where
  append (Finalizer a) (Finalizer b) = Finalizer (a *> b)

instance monoidFinalizer :: Applicative m => Monoid (Finalizer m) where
  mempty = Finalizer (pure unit)

-- | Runs a finalizer.
finalize :: forall m. Finalizer m -> m Unit
finalize (Finalizer a) = a

-- | Changes the effect monad for a finalizer.
hoistFinalizer :: forall m n. (m ~> n) -> Finalizer m -> Finalizer n
hoistFinalizer nat (Finalizer a) = Finalizer (nat a)

module Halogen.Query.EventSource where

import Prelude

import Control.Coroutine as CR
import Control.Monad.Aff (Aff, attempt, launchAff_)
import Control.Monad.Aff.AVar (AVAR)
import Control.Monad.Aff.AVar as AV
import Control.Monad.Aff.Class (class MonadAff, liftAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception as Exn
import Control.Monad.Free.Trans as FT
import Control.Monad.Trans.Class (lift)
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Monoid (class Monoid)
import Data.Profunctor (dimap)

-- | An event source definition - an effect in `m` that when run returns a
-- | producer coroutine that emits queries of type `f`, and runs in the effect
-- | monad `m`.
-- |
-- | It's generally unnecessary to build values of this type directly with this
-- | constructor, the `affEventSource` and `effEventSource` cover the most
-- | event source constructions.
newtype EventSource m f = EventSource (m { producer :: CR.Producer (f Unit) m Unit, finalizer :: Finalizer m })

-- | Constructs an event source from a setup function that operates in `Aff`.
-- |
-- | - The `Emitter` that the passed function receives is used to `emit` queries
-- |   that will be received by the current component, or can be `close`d to
-- |   shut down the event source and remove the subscription.
-- | - The `Finalizer` that the passed function produces is there to allow for
-- |   some clean-up action to be taken when the event source is unsubscribed
-- |   from. This also runs if the `Emitter` is `close`d. `mempty` can be used
-- |   here if there is no clean-up to perform.
affEventSource
  :: forall m f eff
   . MonadAff (avar :: AVAR | eff) m
  => (Emitter (Aff (avar :: AVAR | eff)) f -> Aff (avar :: AVAR | eff) (Finalizer (Aff (avar :: AVAR | eff))))
  -> EventSource m f
affEventSource recv = EventSource $ liftAff do
  inputVar <- AV.makeEmptyVar
  finalizeVar <- AV.makeEmptyVar
  let
    producer = do
      lift $ liftAff $ flip AV.putVar finalizeVar =<< recv (Emitter (flip AV.putVar inputVar))
      CR.producer $ liftAff $ AV.takeVar inputVar
    finalizer = Finalizer do
      liftAff (attempt (AV.takeVar finalizeVar)) >>= case _ of
        Left _ -> pure unit
        Right finalizer -> liftAff do
          AV.killVar (Exn.error "finalized") finalizeVar
          finalize finalizer
  pure { producer, finalizer }

-- | Constructs an event source from a setup function that operates in `Eff`.
-- |
-- | - The `Emitter` that the passed function receives is used to `emit` queries
-- |   that will be received by the current component, or can be `close`d to
-- |   shut down the event source and remove the subscription.
-- | - The `Finalizer` that the passed function produces is there to allow for
-- |   some clean-up action to be taken when the event source is unsubscribed
-- |   from. This also runs if the `Emitter` is `close`d. `mempty` can be used
-- |   here if there is no clean-up to perform.
effEventSource
  :: forall m f eff
   . MonadAff (avar :: AVAR | eff) m
  => (Emitter (Eff (avar :: AVAR | eff)) f -> Eff (avar :: AVAR | eff) (Finalizer (Eff (avar :: AVAR | eff))))
  -> EventSource m f
effEventSource =
  affEventSource <<<
    dimap (hoistEmitter launchAff_) (liftEff <<< map (hoistFinalizer liftEff))

-- | Changes the query component of an event source.
interpret :: forall m f g. Functor m => (f ~> g) -> EventSource m f -> EventSource m g
interpret f (EventSource es) =
  EventSource $
    map
      (\e -> { producer: FT.interpret (lmap f) e.producer, finalizer: e.finalizer })
      es

-- | Changes the effect monad component of an event source.
hoist :: forall m n f. Functor n => (m ~> n) -> EventSource m f -> EventSource n f
hoist nat (EventSource es) =
  EventSource $
    map
      (\e -> { producer: FT.hoistFreeT nat e.producer, finalizer: hoistFinalizer nat e.finalizer })
      (nat es)

-- | Values of this type are created internally by `affEventSource` and
-- | `effEventSource`, and then passed into the user-provided setup function.
-- |
-- | This type is just a wrapper around a callback, used to simplify the type
-- | signatures for setting up event sources.
newtype Emitter m f = Emitter (Either (f Unit) Unit -> m Unit)

-- | Emits an "action style" query via the emitter. Accepts a partially applied
-- | query constructor to save having to use `H.action` or applying `unit` when
-- | constructing the query, for example:
-- |
-- | ``` purescript
-- | data Query a = Notify String a
-- |
-- | myEventSource = EventSource.affEventSource \emitter -> do
-- |   Aff.delay (Milliseconds 1000.0)
-- |   EventSource.emit emitter (Notify "hello")
-- |   pure mempty
-- | ```
emit :: forall m f. Emitter m f -> (Unit -> f Unit) -> m Unit
emit (Emitter f) q = f (Left (q unit))

-- | Closes the emitter, shutting down the event source. This allows an event
-- | source to stop itself internally, rather than requiring external shutdown
-- | by unsubscribing from it.
-- |
-- | The event source will automatically be unsubscribed from when this is
-- | called, and the finalizer returned during event source setup will be
-- | executed.
-- |
-- | Any further calls to `emit` after `close` will be ignored.
close :: forall m a. Emitter m a -> m Unit
close (Emitter f) = f (Right unit)

-- | Changes the effect monad for an emitter.
hoistEmitter :: forall m n f. (m Unit -> n Unit) -> Emitter m f -> Emitter n f
hoistEmitter nat (Emitter f) = Emitter (nat <<< f)

-- | When setting up an event source, values of this type should be returned to
-- | describe any clean-up operations required. This is just a newtype around
-- | an effectful operation, but helps with type signature comprehension.
-- |
-- | There is a `Monoid` instance provided for finalizers, so `mempty` can be
-- | used in cases where there are no relevant clean-up actions to take.
newtype Finalizer m = Finalizer (m Unit)

instance semigroupFinalizer :: Apply m => Semigroup (Finalizer m) where
  append (Finalizer a) (Finalizer b) = Finalizer (a *> b)

instance monoidFinalizer :: Applicative m => Monoid (Finalizer m) where
  mempty = Finalizer (pure unit)

-- | Runs a finalizer.
finalize :: forall m. Finalizer m -> m Unit
finalize (Finalizer a) = a

-- | Changes the effect monad for a finalizer.
hoistFinalizer :: forall m n. (m ~> n) -> Finalizer m -> Finalizer n
hoistFinalizer nat (Finalizer a) = Finalizer (nat a)


use Record Builder

use Record Builder

module Simple.JSON (
  readJSON
, writeJSON
, write
, read

, class ReadForeign
, readImpl

, class ReadForeignFields
, getFields

, class WriteForeign
, writeImpl

, class WriteForeignFields
, writeImplFields

) where

import Prelude

import Control.Monad.Except (withExcept)
import Data.Foreign (F, Foreign, ForeignError(..), readArray, readBoolean, readChar, readInt, readNumber, readString, toForeign)
import Data.Foreign.Index (readProp)
import Data.Foreign.Internal (readStrMap)
import Data.Foreign.JSON (parseJSON)
import Data.Foreign.NullOrUndefined (NullOrUndefined(NullOrUndefined), readNullOrUndefined, unNullOrUndefined, undefined)
import Data.Maybe (Maybe(..), maybe)
import Data.Nullable (toNullable)
import Data.Record (get)
import Data.Record.Builder (Builder)
import Data.Record.Builder as Builder
import Data.StrMap as StrMap
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Data.Traversable (sequence)
import Global.Unsafe (unsafeStringify)
import Type.Row (class RowLacks, class RowToList, Cons, Nil, RLProxy(RLProxy), kind RowList)

-- | Read a JSON string to a type `a` using `F a`. Useful with record types.
readJSON :: forall a
  .  ReadForeign a
  => String
  -> F a
readJSON = readImpl <=< parseJSON

-- | Write a JSON string from a type `a`.
writeJSON :: forall a
  .  WriteForeign a
  => a
  -> String
writeJSON = unsafeStringify <<< writeImpl

write :: forall a
  .  WriteForeign a
  => a
  -> Foreign
write = writeImpl

read :: forall a
  .  ReadForeign a
  => Foreign
  -> F a
read = readImpl

-- | A class for reading foreign values to a type
class ReadForeign a where
  readImpl :: Foreign -> F a

instance readForeign :: ReadForeign Foreign where
  readImpl = pure

instance readChar :: ReadForeign Char where
  readImpl = readChar

instance readNumber :: ReadForeign Number where
  readImpl = readNumber

instance readInt :: ReadForeign Int where
  readImpl = readInt

instance readString :: ReadForeign String where
  readImpl = readString

instance readBoolean :: ReadForeign Boolean where
  readImpl = readBoolean

instance readArray :: ReadForeign a => ReadForeign (Array a) where
  readImpl = readElements <=< readArray
    where
      readElements xs = sequence $ readImpl <$> xs

instance readNullOrUndefined :: ReadForeign a => ReadForeign (NullOrUndefined a) where
  readImpl = readNullOrUndefined readImpl

instance readMaybe :: ReadForeign a => ReadForeign (Maybe a) where
  readImpl = map unNullOrUndefined <<< readImpl

instance readStrMap :: ReadForeign a => ReadForeign (StrMap.StrMap a) where
  readImpl = sequence <<< StrMap.mapWithKey (const readImpl) <=< readStrMap

instance readRecord ::
  ( RowToList fields fieldList
  , ReadForeignFields fieldList () fields
  ) => ReadForeign (Record fields) where
  readImpl o = do
    steps <- getFields fieldListP o
    pure $ Builder.build steps {}
    where
      fieldListP = RLProxy :: RLProxy fieldList

-- | A class for reading foreign values from properties
class ReadForeignFields (xs :: RowList) (from :: # Type) (to :: # Type)
  | xs -> from to where
  getFields :: RLProxy xs
    -> Foreign
    -> F (Builder (Record from) (Record to))

instance readFieldsCons ::
  ( IsSymbol name
  , ReadForeign ty
  , ReadForeignFields tail from from'
  , RowLacks name from'
  , RowCons name ty from' to
  ) => ReadForeignFields (Cons name ty tail) from to where
  getFields _ obj = do
    value :: ty <- withExcept' $ readImpl =<< readProp name obj
    rest <- getFields tailP obj
    let
      first :: Builder (Record from') (Record to)
      first = Builder.insert nameP value
    pure $ first <<< rest
    where
      nameP = SProxy :: SProxy name
      tailP = RLProxy :: RLProxy tail
      name = reflectSymbol nameP
      withExcept' = withExcept <<< map $ ErrorAtProperty name

instance readFieldsNil ::
  ReadForeignFields Nil () () where
  getFields _ _ =
    pure id

-- | A class for writing a value into JSON
-- | need to do this intelligently using Foreign probably, because of null and undefined whatever
class WriteForeign a where
  writeImpl :: a -> Foreign

instance writeForeignForeign :: WriteForeign Foreign where
  writeImpl = id

instance writeForeignString :: WriteForeign String where
  writeImpl = toForeign

instance writeForeignInt :: WriteForeign Int where
  writeImpl = toForeign

instance writeForeignChar :: WriteForeign Char where
  writeImpl = toForeign

instance writeForeignNumber :: WriteForeign Number where
  writeImpl = toForeign

instance writeForeignBoolean :: WriteForeign Boolean where
  writeImpl = toForeign

instance writeForeignArray :: WriteForeign a => WriteForeign (Array a) where
  writeImpl xs = toForeign $ writeImpl <$> xs

instance writeForeignNullOrUndefined :: WriteForeign a => WriteForeign (NullOrUndefined a) where
  writeImpl (NullOrUndefined a) = maybe undefined writeImpl a

instance writeForeignMaybe :: WriteForeign a => WriteForeign (Maybe a) where
  writeImpl (Just a) = writeImpl a
  writeImpl Nothing = toForeign $ toNullable Nothing

instance writeForeignStrMap :: WriteForeign a => WriteForeign (StrMap.StrMap a) where
  writeImpl = toForeign <<< StrMap.mapWithKey (const writeImpl)

instance recordWriteForeign ::
  ( RowToList row rl
  , WriteForeignFields rl row () to
  ) => WriteForeign (Record row) where
  writeImpl rec = toForeign $ Builder.build steps {}
    where
      rlp = RLProxy :: RLProxy rl
      steps = writeImplFields rlp rec

class WriteForeignFields (rl :: RowList) row (from :: # Type) (to :: # Type)
  | rl -> row from to where
  writeImplFields :: forall g. g rl -> Record row -> Builder (Record from) (Record to)

instance consWriteForeignFields ::
  ( IsSymbol name
  , WriteForeign ty
  , WriteForeignFields tail row from from'
  , RowCons name ty whatever row
  , RowLacks name from'
  , RowCons name Foreign from' to
  ) => WriteForeignFields (Cons name ty tail) row from to where
  writeImplFields _ rec = result
    where
      namep = SProxy :: SProxy name
      value = writeImpl $ get namep rec
      tailp = RLProxy :: RLProxy tail
      rest = writeImplFields tailp rec
      result = Builder.insert namep value <<< rest

instance nilWriteForeignFields ::
  WriteForeignFields Nil row () () where
  writeImplFields _ _ = id

module Simple.JSON (
  readJSON
, writeJSON
, write
, read

, class ReadForeign
, readImpl

, class ReadForeignFields
, getFields

, class WriteForeign
, writeImpl

, class WriteForeignFields
, writeImplFields

) where

import Prelude

import Control.Monad.Except (withExcept)
import Data.Foreign (F, Foreign, ForeignError(..), readArray, readBoolean, readChar, readInt, readNumber, readString, toForeign)
import Data.Foreign.Index (readProp)
import Data.Foreign.Internal (readStrMap)
import Data.Foreign.JSON (parseJSON)
import Data.Foreign.NullOrUndefined (NullOrUndefined(NullOrUndefined), readNullOrUndefined, unNullOrUndefined, undefined)
import Data.Maybe (Maybe(..), maybe)
import Data.Nullable (toNullable)
import Data.Record (get, insert)
import Data.StrMap as StrMap
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Data.Traversable (sequence)
import Global.Unsafe (unsafeStringify)
import Type.Prelude (class TypeEquals, to)
import Type.Row (class ListToRow, class RowLacks, class RowToList, Cons, Nil, RLProxy(RLProxy), RProxy(..), kind RowList)

-- | Read a JSON string to a type `a` using `F a`. Useful with record types.
readJSON :: forall a
  .  ReadForeign a
  => String
  -> F a
readJSON = readImpl <=< parseJSON

-- | Write a JSON string from a type `a`.
writeJSON :: forall a
  .  WriteForeign a
  => a
  -> String
writeJSON = unsafeStringify <<< writeImpl

write :: forall a
  .  WriteForeign a
  => a
  -> Foreign
write = writeImpl

read :: forall a
  .  ReadForeign a
  => Foreign
  -> F a
read = readImpl

-- | A class for reading foreign values to a type
class ReadForeign a where
  readImpl :: Foreign -> F a

instance readForeign :: ReadForeign Foreign where
  readImpl = pure

instance readChar :: ReadForeign Char where
  readImpl = readChar

instance readNumber :: ReadForeign Number where
  readImpl = readNumber

instance readInt :: ReadForeign Int where
  readImpl = readInt

instance readString :: ReadForeign String where
  readImpl = readString

instance readBoolean :: ReadForeign Boolean where
  readImpl = readBoolean

instance readArray :: ReadForeign a => ReadForeign (Array a) where
  readImpl = readElements <=< readArray
    where
      readElements xs = sequence $ readImpl <$> xs

instance readNullOrUndefined :: ReadForeign a => ReadForeign (NullOrUndefined a) where
  readImpl = readNullOrUndefined readImpl

instance readMaybe :: ReadForeign a => ReadForeign (Maybe a) where
  readImpl = map unNullOrUndefined <<< readImpl

instance readStrMap :: ReadForeign a => ReadForeign (StrMap.StrMap a) where
  readImpl = sequence <<< StrMap.mapWithKey (const readImpl) <=< readStrMap

instance readRecord ::
  ( RowToList fields fieldList
  , ReadForeignFields fieldList fields
  , ListToRow fieldList fields
  ) => ReadForeign (Record fields) where
  readImpl = getFields (RLProxy :: RLProxy fieldList) (RProxy :: RProxy fields)

-- | A class for reading foreign values from properties
class ReadForeignFields (xs :: RowList) (row :: # Type) where
  getFields :: RLProxy xs
    -> RProxy row
    -> Foreign
    -> F (Record row)

instance readFieldsCons ::
  ( IsSymbol name
  , ReadForeign ty
  , ReadForeignFields tail tailRow
  , RowLacks name tailRow
  , RowCons name ty tailRow row
  ) => ReadForeignFields (Cons name ty tail) row where
  getFields _ _ obj = do
    value <- withExcept' $ readImpl =<< readProp name obj
    rest <- getFields tailP tailRowP obj
    pure $ insert nameP value rest
    where
      nameP = SProxy :: SProxy name
      tailP = RLProxy :: RLProxy tail
      tailRowP = RProxy :: RProxy tailRow
      name = reflectSymbol nameP
      withExcept' = withExcept <<< map $ ErrorAtProperty name

instance readFieldsNil ::
  ( TypeEquals {} (Record row)
  ) => ReadForeignFields Nil row where
  getFields _ _ _ =
    pure $ to {}

-- | A class for writing a value into JSON
-- | need to do this intelligently using Foreign probably, because of null and undefined whatever
class WriteForeign a where
  writeImpl :: a -> Foreign

instance writeForeignForeign :: WriteForeign Foreign where
  writeImpl = id

instance writeForeignString :: WriteForeign String where
  writeImpl = toForeign

instance writeForeignInt :: WriteForeign Int where
  writeImpl = toForeign

instance writeForeignChar :: WriteForeign Char where
  writeImpl = toForeign

instance writeForeignNumber :: WriteForeign Number where
  writeImpl = toForeign

instance writeForeignBoolean :: WriteForeign Boolean where
  writeImpl = toForeign

instance writeForeignArray :: WriteForeign a => WriteForeign (Array a) where
  writeImpl xs = toForeign $ writeImpl <$> xs

instance writeForeignNullOrUndefined :: WriteForeign a => WriteForeign (NullOrUndefined a) where
  writeImpl (NullOrUndefined a) = maybe undefined writeImpl a

instance writeForeignMaybe :: WriteForeign a => WriteForeign (Maybe a) where
  writeImpl (Just a) = writeImpl a
  writeImpl Nothing = toForeign $ toNullable Nothing

instance writeForeignStrMap :: WriteForeign a => WriteForeign (StrMap.StrMap a) where
  writeImpl = toForeign <<< StrMap.mapWithKey (const writeImpl)

instance recordWriteForeign ::
  ( RowToList row rl
  , WriteForeignFields rl row row'
  ) => WriteForeign (Record row) where
  writeImpl rec = toForeign $ writeImplFields rlp rec
    where
      rlp = RLProxy :: RLProxy rl

class WriteForeignFields (rl :: RowList) row (row' :: # Type)
  | rl -> row row' where
  writeImplFields :: forall g. g rl -> Record row -> Record row'

instance consWriteForeignFields ::
  ( IsSymbol name
  , WriteForeign ty
  , WriteForeignFields tail row tailRow
  , RowCons name ty whatever row
  , RowLacks name tailRow
  , RowCons name Foreign tailRow row'
  ) => WriteForeignFields (Cons name ty tail) row row' where
  writeImplFields _ rec = result
    where
      namep = SProxy :: SProxy name
      value = writeImpl $ get namep rec
      tailp = RLProxy :: RLProxy tail
      rest = writeImplFields tailp rec
      result = insert namep value rest

instance nilWriteForeignFields ::
  ( TypeEquals {} (Record row')
  ) => WriteForeignFields Nil row row' where
  writeImplFields _ _ = to {}