Row maps test

RowListMaps.purs

module Test.RowListMaps where

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Maybe (fromJust)
import Data.StrMap as SM
import Data.Tuple (Tuple(..))
import Data.Variant (Variant, inj, SProxy(..))
import Global.Unsafe (unsafeStringify)
import Partial.Unsafe (unsafePartial)
import Prelude
import Type.Row (class RowToList, class ListToRow)
import Type.Row as R
import Unsafe.Coerce (unsafeCoerce)

-- | A common operation seems to be checking that each row in one record has
-- | a certain type based on the other record. The particular constraint usually
-- | has extra data to pass in, like a type for the result of the computation
-- | or a common row for effects, so that is also passed to this class to be
-- | applied to a bifunctorish type, which receives both the data and the type
-- | of each row of input and should equal the type of the corresponding row of
-- | output.
-- |
-- | Since we cannot define partially applied type aliases, which would allow
-- | flipping a bifunctorishtype's arguments, we instead provide two maps.
-- | MapAsFst puts the RowList item's type in first position, with the extra
-- | data coming second, and MapAsSnd puts the RowList item's type in second
-- | after the data.
class MapAsFst
    (functorWith :: Type -> Type -> Type)
    (input :: R.RowList)
    (withData :: Type)
    (output :: R.RowList)
  | functorWith withData input -> output
  , functorWith withData output -> input
instance mapAsFstNil :: MapAsFst f R.Nil d R.Nil
instance mapAsFstCons ::
  MapAsFst f input d output =>
  MapAsFst f (R.Cons sym a input) d (R.Cons sym (f a d) output)

class MapAsSnd
    (functorWith :: Type -> Type -> Type)
    (withData :: Type)
    (input :: R.RowList)
    (output :: R.RowList)
  | functorWith withData input -> output
  , functorWith withData output -> input
instance mapAsSndNil :: MapAsSnd f d R.Nil R.Nil
instance mapAsSndCons ::
  MapAsSnd f d input output =>
  MapAsSnd f d (R.Cons sym a input) (R.Cons sym (f d a) output)

-- | Wrappers to operate on rows, not rowlists.
class MapRowAsFst
    (functorWith :: Type -> Type -> Type)
    (input :: # Type)
    (withData :: Type)
    (output :: # Type)
  | functorWith withData input -> output
  , functorWith withData output -> input
instance mapRowAsFst ::
  ( RowToList i ilist
  , RowToList o olist
  , MapAsFst f ilist d olist
  , ListToRow ilist i
  , ListToRow olist o
  ) => MapRowAsFst f i d o

class MapRowAsSnd
    (functorWith :: Type -> Type -> Type)
    (withData :: Type)
    (input :: # Type)
    (output :: # Type)
  | functorWith withData input -> output
  , functorWith withData output -> input
instance mapRowAsSnd ::
  ( RowToList i ilist
  , RowToList o olist
  , MapAsSnd f d ilist olist
  , ListToRow ilist i
  , ListToRow olist o
  ) => MapRowAsSnd f d i o

-- | Explode a value into a record by applying each function in a record to it.
explode ::
  forall seed fns results.
    MapRowAsSnd (->) seed fns results =>
  seed -> Record fns -> Record results
explode seed fns =
  asRecord (map (\fn -> fn seed) (asStrMap fns))
  where
  asStrMap :: forall a. Record fns -> SM.StrMap (seed -> a)
  asStrMap = unsafeCoerce

  asRecord :: forall a. SM.StrMap a -> Record results
  asRecord = unsafeCoerce

-- | Grant the value in the variant to the corresponding function in the record.
grant ::
  forall variant record result.
    MapRowAsFst (->) variant result record =>
  Record record -> Variant variant -> result
grant r v =
  case coerceV v of
    Tuple tag a →
      a # unsafePartial fromJust
        (SM.lookup tag (coerceR r))
  where
  coerceV ∷ ∀ a. Variant variant → Tuple String a
  coerceV = unsafeCoerce

  coerceR ∷ ∀ a. Record record → SM.StrMap (a -> result)
  coerceR = unsafeCoerce

-- | Use a variant to pick a single field out of a record to apply the variant's
-- | function to.
pick ::
  forall variant record result.
    MapRowAsFst (->) record result variant =>
  Variant variant -> Record record -> result
pick v r =
  case coerceV v of
    Tuple tag a →
      a $ unsafePartial fromJust
        (SM.lookup tag (coerceR r))
  where
  coerceV ∷ ∀ a. Variant variant → Tuple String (a -> result)
  coerceV = unsafeCoerce

  coerceR ∷ ∀ a. Record record → SM.StrMap a
  coerceR = unsafeCoerce

-- | An actual exploder has to be strictly typed to ensure no unknown type
-- | variables get in the way of finding instances. Therefore, make a type alias
-- | to allow easy binding of an exploder to a particular type later.
type Exploder a =
  Show a => Ring a =>
  { same :: a -> a, shown :: a -> String, negative :: a -> a }
exploder :: forall a. Exploder a
exploder =
  { same: id
  , shown: show
  , negative: negate
  }

main :: Eff (console :: CONSOLE) Unit
main = do
  let exploded = explode 42 (exploder :: Exploder Int)
  -- >> {"same":42,"shown":"42","negative":-42}
  log (unsafeStringify exploded)
  -- >> this is a present
  log $ grant
    { this: \s -> "this " <> s, that: \_ -> "is not" }
    (inj (SProxy :: SProxy "this") "is a present")
  -- >> this is also a present
  log $ pick
    (inj (SProxy :: SProxy "this") (\s -> s <> "is also a present"))
    { this: "this ", that: unit }