Using a dictionary to decide a runtime implementation

Try2.purs

module Try2 where

import Prelude

import Control.Monad.Rec.Class (forever)
import Data.Tuple (uncurry)
import Data.Tuple.Nested ((/\), type (/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Effect.Class.Console (logShow)
import Global (readFloat)
import Math (pi)
import Utils (Readline, _rl, question, unsafeCoerce)

type ToDefine r =  { area :: r -> Number, get :: Readline -> Aff r }

data Shape r = Circle (ToDefine r) | Rectangle (ToDefine r)

type Radius = Number
type Width = Number
type Height = Number

circleImplementation :: Shape Radius
circleImplementation =
  Circle $
    { area: \r -> pi * r * r
    , get: \rl -> readFloat <$> question rl "Enter the radius "
    }

rectangleImplementation :: Shape (Width /\ Height)
rectangleImplementation =
  Rectangle $
    { area: uncurry (*)
    , get:
      \rl ->
        (/\)
          <$> (readFloat <$> question rl "Enter the Width ")
          <*> (readFloat <$> question rl "Enter the Height ")
    }

calculateAreaAfterAskingParams :: ∀ r. Readline -> Shape r -> Aff Number
calculateAreaAfterAskingParams rl =
  genericUseTodefine $ calculateAreaAfterAskingParams_ rl

-- This function is independent of whether its a circle or rectangle
calculateAreaAfterAskingParams_ :: ∀ r. Readline -> ToDefine r -> Aff Number
calculateAreaAfterAskingParams_ rl { area, get } =
  area <$> get rl

genericUseTodefine :: ∀ a r. (ToDefine r -> a) -> Shape r -> a
genericUseTodefine f = f <<< unwrapShape
  where
    unwrapShape = case _ of
      (Circle r) -> r
      (Rectangle r) -> r

main :: Effect Unit
main = void $ launchAff do
  rl <- liftEffect _rl
  forever do
    question rl "What shape will you work on ? " >>= ( case _ of
      -- Take the decision on the right dictionary to use
      "Circle" -> calculateAreaAfterAskingParams rl circleImplementation
      "Rectangle" -> calculateAreaAfterAskingParams rl rectangleImplementation
      _ -> unsafeCoerce unit ) >>= logShow

Try3.purs

module Try3 where

import Prelude

import Control.Monad.Rec.Class (forever)
import Data.Tuple.Nested (type (/\), (/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Effect.Class.Console (logShow)
import Global (readFloat)
import Math (pi)
import Type.Proxy (Proxy(..))
import Utils (Readline, _rl, question, unsafeCoerce)

data Circle = Circle Number

data Rectangle = Rectangle (Number /\ Number)

class Shape a where
  get :: Readline -> Aff a
  area :: a -> Number

instance circleShape :: Shape Circle where
  get rl = (Circle <<< readFloat) <$> question rl "Enter the radius"
  area (Circle r) = pi * r * r

instance rectShape :: Shape Rectangle where
  get rl = map Rectangle $
    ((/\))
    <$> (readFloat <$> question rl "Enter the height")
    <*> (readFloat <$> question rl "Enter the width")
  area (Rectangle (w /\ h)) = w * h

getAreaAfterReadingParams :: ∀ a . Shape a ⇒ Proxy a -> Readline → Aff Number
getAreaAfterReadingParams proxy rl = (area :: a -> Number) <$> get rl

main :: Effect Unit
main = void $ launchAff do
  rl <- liftEffect _rl
  forever do
    question rl "What shape will you work on ? " >>= ( case _ of
      -- Take the decision on the right dictionary to use
      "Circle" -> getAreaAfterReadingParams (Proxy :: Proxy Circle) rl
      "Rectangle" -> getAreaAfterReadingParams (Proxy ::Proxy Rectangle) rl
      _ -> unsafeCoerce unit ) >>= logShow

Try4.purs

module Try4 where

import Prelude

import Control.Monad.Rec.Class (forever)
import Data.Tuple.Nested (type (/\), (/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Effect.Class.Console (logShow)
import Global (readFloat)
import Math (pi)
import Utils (Readline, _rl, question, unsafeCoerce)

data Circle = Circle Number

data Rectangle = Rectangle (Number /\ Number)

class Shape a where
  get :: Readline -> Aff a
  area :: a -> Number

instance circleShape :: Shape Circle where
  get rl = (Circle <<< readFloat) <$> question rl "Enter the radius"
  area (Circle r) = pi * r * r

instance rectShape :: Shape Rectangle where
  get rl = map Rectangle $
    ((/\))
    <$> (readFloat <$> question rl "Enter the height")
    <*> (readFloat <$> question rl "Enter the width")
  area (Rectangle (w /\ h)) = w * h

getAreaAfterReadingParams :: ∀ a . Shape a ⇒ a -> Readline → Aff Number
getAreaAfterReadingParams _ rl = (area :: a -> Number) <$> get rl

main :: Effect Unit
main = void $ launchAff do
  rl <- liftEffect _rl
  forever do
    question rl "What shape will you work on ? " >>= ( case _ of
      -- Take the decision on the right dictionary to use
      "Circle" -> getAreaAfterReadingParams dummyCircle rl
      "Rectangle" -> getAreaAfterReadingParams dummyRect rl
      _ -> unsafeCoerce unit ) >>= logShow
      where
        dummyCircle = Circle 0.0
        dummyRect = Rectangle (0.0 /\ 0.0)

Utils.js

const readline = require('readline');
exports._rl = function(){
  return readline.createInterface({
  input: process.stdin,
  output: process.stdout
  });
}

exports._question = function(rl){
  return function(q){
    return function(c){
      return function(err, succ){
        rl.question(q, function(ans){
            succ(ans);
        })
        return function(ce, cancErr, cancSucc){
          c();
          cancSucc();
        }
      }
    }
  }
}

exports.unsafeCoerce = function(x){
  return x;
}

Utils.purs

module Utils where

import Prelude

import Effect (Effect)
import Effect.Aff (Aff, Canceler(..))
import Effect.Aff.Compat (EffectFnAff(..), fromEffectFnAff)
import Unsafe.Coerce (unsafeCoerce)

foreign import data Readline :: Type
foreign import _rl :: Effect Readline
foreign import _question :: Readline -> String -> Canceler -> EffectFnAff String

question :: Readline → String → Aff String
question rl s = fromEffectFnAff $ _question rl s mempty

foreign import unsafeCoerce :: forall a b. a -> b