Created
September 23, 2022 23:45
-
-
Save JordanMartinez/01ee80d6066b381e8f0915308adc255c to your computer and use it in GitHub Desktop.
Delgate type class implementation to external one
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Foo where | |
import Prelude | |
import Control.Monad.Reader (ReaderT(..), runReader, runReaderT) | |
import Data.Array.NonEmpty (NonEmptyArray) | |
import Data.Identity (Identity) | |
import Data.Maybe (Maybe) | |
import Data.Symbol (class IsSymbol) | |
import Data.Tuple (Tuple(..)) | |
import Effect (Effect) | |
import Effect.Console (log) | |
import Prim.Row as Row | |
import Record as Record | |
import Safe.Coerce (coerce) | |
import Type.Equality (class TypeEquals) | |
import Type.Proxy (Proxy(..)) | |
-- | Same rows as referenced by `ExternalRef` | |
newtype ExternalRefRec rows = ExternalRefRec { | rows } | |
-- | A symbol indicate which of all the rows to use to provide an implementation | |
-- | for `a` | |
newtype ExternalRef :: Row Type -> Symbol -> Type -> Type | |
newtype ExternalRef rows sym a = ExternalRef a | |
class Delegate rows a where | |
delegate :: ReaderT (ExternalRefRec rows) Identity a | |
-- | Tuple delegates to its inner parts and then wraps them... | |
instance (Delegate rows a, Delegate rows b) => Delegate rows (Tuple a b) where | |
delegate = Tuple <$> delegate <$> delegate | |
-- | `ExternalRef` delegates to the external implementation provided via the `ExternalRefRec` | |
-- | which spontaneously appears via the `ReaderT`. | |
instance | |
( Row.Cons sym (ReaderT (ExternalRefRec rows) Identity a) tail rows | |
, IsSymbol sym | |
) => | |
Delegate rows (ExternalRef rows sym a) where | |
delegate = ReaderT \input@(ExternalRefRec rec) -> do | |
let | |
externalImplementation :: ReaderT (ExternalRefRec rows) Identity a | |
externalImplementation = Record.get (Proxy :: Proxy sym) rec | |
wrapInExternalRef | |
:: ReaderT (ExternalRefRec rows) Identity a | |
-> ReaderT (ExternalRefRec rows) Identity (ExternalRef rows sym a) | |
wrapInExternalRef = coerce | |
runReaderT (wrapInExternalRef externalImplementation) input | |
-- Provide an example showing a type class instance being | |
-- implemented via an external implementation. If possible, | |
-- this is another way around the orphan instances restriction. | |
main :: Effect Unit | |
main = do | |
log $ show $ example | |
where | |
example :: Tuple String String | |
example = dropExternalRefs $ (ExternalRefRec { str1: "one", str2: "two" }) # runReader do | |
(delegate :: ReaderT _ Identity (Tuple (ExternalRef _ "str1" String) (ExternalRef _ "str2" String))) | |
dropExternalRefs | |
:: Tuple (ExternalRef _ "str1" String) (ExternalRef _ "str2" String) | |
-> Tuple String String | |
dropExternalRefs = coerce |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment