Data commit

Task/Monads-Maybe-monad/00-META.yaml

@@ -0,0 +1,4 @@
+---
+category:
+- Monads
+from: http://rosettacode.org/wiki/Monads/Maybe_monad

Task/Monads-Maybe-monad/00-TASK.txt

@@ -0,0 +1,11 @@
+Demonstrate in your programming language the following:
+
+#Construct a Maybe Monad by writing the 'bind' function and the 'unit' (sometimes known as 'return') function for that Monad (or just use what the language already has implemented)
+#Make two functions, each which take a number and return a monadic number, e.g. Int -> Maybe Int and Int -> Maybe String
+#Compose the two functions with bind
+
+
+A [[wp:Monad_(functional_programming)|Monad]] is a single type which encapsulates several other types, eliminating boilerplate code. In practice it acts like a dynamically typed computational sequence, though in many cases the type issues can be resolved at compile time.
+
+A Maybe Monad is a monad which specifically encapsulates the type of an undefined value.
+

Task/Monads-Maybe-monad/ALGOL-68/monads-maybe-monad.alg

@@ -0,0 +1,126 @@
+BEGIN
+
+    # This is a translation of the Javascript sample, main differences are because Algol 68    #
+    # is strongly typed and "on-the-fly" constructon of functions is not really possible -     #
+    # we need to define a STRUCT where Javascript would just construct a new function.         #
+    # As Algol 68 does not allow procedure overloading, we use custom operators (which do      #
+    # allow overloading) so the techniques used here could be extended to procedures with      #
+    # signatures other than PROC(REAL)REAL                                                     #
+    # The comments are generally the same as in the javascript original, changed as necessary  #
+    # to reflect Algol 68...                                                                   #
+
+    # START WITH SOME SIMPLE (UNSAFE) PARTIAL FUNCTIONS:                                       #
+
+    # error in n < 0 #
+    PROC unsafe reciprocal = (REAL n)REAL: 1 / n;
+    # error if n < 0 #
+    PROC unsafe root       = (REAL n)REAL: sqrt(n);
+    # error if n <= 0 #
+    PROC unsafe log        = (REAL n)REAL: ln(n);
+
+
+    # NOW DERIVE SAFE VERSIONS OF THESE SIMPLE FUNCTIONS:                                      #
+    # These versions use a validity test, and return a wrapped value                           #
+    # with a boolean is valid property as well as a value property                             #
+
+    MODE SAFEFUNCTION = STRUCT( PROC(REAL)REAL fn, PROC(REAL)BOOL fn safety check );
+    MODE MAYBE        = STRUCT( BOOL is valid, REAL value );
+
+    SAFEFUNCTION safe reciprocal = ( unsafe reciprocal, ( REAL n )BOOL: n /= 0 );
+    SAFEFUNCTION safe root       = ( unsafe root,       ( REAL n )BOOL: n >= 0 );
+    SAFEFUNCTION safe log        = ( unsafe log,        ( REAL n )BOOL: n >  0 );
+
+COMMENT
+    the original Javascript contains this:
+
+    // THE DERIVATION OF THE SAFE VERSIONS USED THE 'UNIT' OR 'RETURN'
+    // FUNCTION OF THE MAYBE MONAD
+
+    // Named maybe() here, the unit function of the Maybe monad wraps a raw value
+    // in a datatype with two elements: .isValid (Bool) and .value (Number)
+
+    // a -> Ma
+    function maybe(n) {
+        return {
+            isValid: (typeof n !== 'undefined'),
+            value: n
+        };
+    }
+
+    However Algol 68 is strongly typed, so the type (MODE) of the function parameters
+    cannot be anything other than REAL. We therefore use "MAYBE( TRUE, n )" instead.
+COMMENT
+
+    # THE PROBLEM FOR FUNCTION NESTING (COMPOSITION) OF THE SAFE FUNCTIONS                     #
+    # IS THAT THEIR INPUT AND OUTPUT TYPES ARE DIFFERENT                                       #
+
+    # Our safe versions of the functions take simple numeric arguments (i.e. REAL), but return #
+    # wrapped results. If we feed a wrapped result as an input to another safe function, the   #
+    # compiler will object. The solution is to write a higher order                            #
+    # function (sometimes called 'bind' or 'chain') which handles composition, taking a        #
+    # a safe function and a wrapped value as arguments,                                        #
+
+    # The 'bind' function of the Maybe monad:                                                  #
+    # 1. Applies a 'safe' function directly to the raw unwrapped value, and                    #
+    # 2. returns the wrapped result.                                                           #
+
+    # Ma -> (a -> Mb) -> Mb #
+    # defined as an operator to allow overloading to other PROC modes                          #
+    PRIO BIND = 1;
+    OP   BIND = (MAYBE maybe n, SAFEFUNCTION mf )MAYBE:
+        IF is valid OF maybe n THEN mf CALL ( value OF maybe n ) ELSE maybe n FI;
+    # we need an operator to call the wrapped function                                         #
+    PRIO CALL = 1;
+    OP   CALL = ( SAFEFUNCTION f, REAL value )MAYBE:
+         BEGIN
+             BOOL is valid = ( fn safety check OF f )( value );
+             MAYBE( is valid, IF is valid THEN ( fn OF f )( value ) ELSE value FI )
+         END; # CALL #
+
+    # Using the bind function, we can nest applications of safe functions,                     #
+    # without the compiler choking on unexpectedly wrapped values returned from                #
+    # other functions of the same kind.                                                        #
+    REAL root one over four = value OF ( MAYBE( TRUE, 4 ) BIND safe reciprocal BIND safe root );
+
+#   print( ( root one over four, newline ) ); #
+    # -> 0.5 #
+
+    # We can compose a chain of safe functions (of any length) with a simple foldr/reduceRight #
+    # which starts by 'lifting' the numeric argument into a Maybe wrapping,                    #
+    # and then nests function applications (working from right to left)                        #
+    # again, defined as an operator here to allow extension to other PROC modes                #
+    # also, as Algol 68 doesn't have builtin foldr/reduceRight, we need a loop...              #
+    PRIO SAFECOMPOSE = 1;
+    OP   SAFECOMPOSE = ( []SAFEFUNCTION lst functions, REAL value )MAYBE:
+         BEGIN
+             MAYBE result := MAYBE( TRUE, value );
+             FOR fn pos FROM UPB lst functions BY -1 TO LWB lst functions DO
+                 result := result BIND lst functions[ fn pos ]
+             OD;
+             result
+         END; # SAFECOMPOSE #
+
+    # TEST INPUT VALUES WITH A SAFELY COMPOSED VERSION OF LOG(SQRT(1/X))                       #
+
+    PROC safe log root reciprocal = ( REAL n )MAYBE:
+         BEGIN
+             # this declaration is requied for Algol 68G 2.8                                   #
+             []SAFEFUNCTION function list = ( safe log, safe root, safe reciprocal );
+             function list SAFECOMPOSE n
+         END; # safe log root reciprocal #
+
+    # Algol 68 doesn't have a builtin map operator, we could define one here but we can just   #
+    # use a loop for the purposes of this task...                                              #
+    REAL e = exp( 1 );
+    []REAL test values = ( -2, -1, -0.5, 0, 1 / e, 1, 2, e, 3, 4, 5 );
+
+    STRING prefix := "[";
+    FOR test pos FROM LWB test values TO UPB test values DO
+        MAYBE result = safe log root reciprocal( test values[ test pos ] );
+        print( ( prefix, IF is valid OF result THEN fixed( value OF result, -12, 8 ) ELSE "undefined" FI ) );
+        IF test pos MOD 4 = 0 THEN print( ( newline ) ) FI;
+        prefix := ", "
+    OD;
+    print( ( "]", newline ) )
+
+END

Task/Monads-Maybe-monad/ATS/monads-maybe-monad.ats

@@ -0,0 +1,35 @@
+#include "share/atspre_staload.hats"
+
+(* There are "Option" and "Option_vt" in the ATS2 prelude, but I shall
+   construct something anew. *)
+
+datatype Maybe (a : t@ype+) =
+| Nothing of ()
+| Just of a
+
+fn {a, b : t@ype}
+bind_Maybe {u : bool}
+           (m : Maybe a,
+            f : a -<cloref1> Maybe b) : Maybe b =
+  case+ m of
+  | Nothing {a} () => Nothing {b} ()
+  | Just {a} x => f x
+
+infixl 0 >>=
+overload >>= with bind_Maybe
+
+implement
+main0 () =
+  let
+    val f : int -<cloref1> Maybe int =
+      lam i =<cloref1> if (i : int) < 0 then Nothing () else Just i
+    val g : int -<cloref1> Maybe string =
+      lam i =<cloref1> Just (tostring_val<int> i)
+  in
+    case+ Just 123 >>= f >>= g of
+    | Nothing () => println! ("Nothing ()")
+    | Just s => println! ("Just (\"", s : string, "\")");
+    case+ Just ~123 >>= f >>= g of
+    | Nothing () => println! ("Nothing ()")
+    | Just s => println! ("Just (\"", s : string, "\")")
+  end

Task/Monads-Maybe-monad/AppleScript/monads-maybe-monad.applescript

@@ -0,0 +1,138 @@
+property e : 2.71828182846
+
+on run {}
+
+    -- Derive safe versions of three simple functions
+    set sfReciprocal to safeVersion(reciprocal, notZero)
+    set sfRoot to safeVersion(root, isPositive)
+    set sfLog to safeVersion(ln, aboveZero)
+
+
+    -- Test a composition of these function with a range of invalid and valid arguments
+
+    -- (The safe composition returns missing value (without error) for invalid arguments)
+
+    map([-2, -1, -0.5, 0, 1 / e, 1, 2, e, 3, 4, 5], safeLogRootReciprocal)
+
+    -- 'missing value' is returned by a safe function (and threaded up through the monad) when the input argument is out of range
+    --> {missing value, missing value, missing value, missing value, 0.5, 0.0, -0.346573590279, -0.499999999999, -0.549306144333, -0.69314718056, -0.804718956217}
+end run
+
+
+-- START WITH SOME SIMPLE (UNSAFE) PARTIAL FUNCTIONS:
+
+-- Returns ERROR 'Script Error: Can’t divide 1.0 by zero.' if n = 0
+on reciprocal(n)
+    1 / n
+end reciprocal
+
+-- Returns ERROR 'error "The result of a numeric operation was too large." number -2702'
+-- for all values below 0
+on root(n)
+    n ^ (1 / 2)
+end root
+
+-- Returns -1.0E+20 for all values of zero and below
+on ln(n)
+    (do shell script ("echo 'l(" & (n as string) & ")' | bc -l")) as real
+end ln
+
+-- DERIVE A SAFE VERSION OF EACH FUNCTION
+-- (SEE on Run() handler)
+
+on safeVersion(f, fnSafetyCheck)
+    script
+        on call(x)
+            if sReturn(fnSafetyCheck)'s call(x) then
+                sReturn(f)'s call(x)
+            else
+                missing value
+            end if
+        end call
+    end script
+end safeVersion
+
+on notZero(n)
+    n is not 0
+end notZero
+
+on isPositive(n)
+    n ≥ 0
+end isPositive
+
+on aboveZero(n)
+    n > 0
+end aboveZero
+
+
+-- DEFINE A FUNCTION WHICH CALLS A COMPOSITION OF THE SAFE VERSIONS
+on safeLogRootReciprocal(x)
+
+    value of mbCompose([my sfLog, my sfRoot, my sfReciprocal], x)
+
+end safeLogRootReciprocal
+
+
+-- UNIT/RETURN and BIND functions for the Maybe monad
+
+-- Unit / Return for maybe
+on maybe(n)
+    {isValid:n is not missing value, value:n}
+end maybe
+
+-- BIND maybe
+on mbBind(recMaybe, mfSafe)
+    if isValid of recMaybe then
+        maybe(mfSafe's call(value of recMaybe))
+    else
+        recMaybe
+    end if
+end mbBind
+
+-- lift 2nd class function into 1st class wrapper
+-- handler function --> first class script object
+on sReturn(f)
+    script
+        property call : f
+    end script
+end sReturn
+
+-- return a new script in which function g is composed
+-- with the f (call()) of the Mf script
+-- Mf -> (f -> Mg) -> Mg
+on sBind(mf, g)
+    script
+        on call(x)
+            sReturn(g)'s call(mf's call(x))
+        end call
+    end script
+end sBind
+
+on mbCompose(lstFunctions, value)
+    reduceRight(lstFunctions, mbBind, maybe(value))
+end mbCompose
+
+-- xs: list, f: function, a: initial accumulator value
+-- the arguments available to the function f(a, x, i, l) are
+-- v: current accumulator value
+-- x: current item in list
+-- i: [ 1-based index in list ] optional
+-- l: [ a reference to the list itself ] optional
+on reduceRight(xs, f, a)
+    set mf to sReturn(f)
+
+    repeat with i from length of xs to 1 by -1
+        set a to mf's call(a, item i of xs, i, xs)
+    end repeat
+end reduceRight
+
+-- [a] -> (a -> b) -> [b]
+on map(xs, f)
+    set mf to sReturn(f)
+    set lst to {}
+    set lng to length of xs
+    repeat with i from 1 to lng
+        set end of lst to mf's call(item i of xs, i, xs)
+    end repeat
+    return lst
+end map

Task/Monads-Maybe-monad/C++/monads-maybe-monad.cpp

@@ -0,0 +1,76 @@
+#include <iostream>
+#include <cmath>
+#include <optional>
+#include <vector>
+
+using namespace std;
+
+// std::optional can be a maybe monad.  Use the >> operator as the bind function
+template <typename T>
+auto operator>>(const optional<T>& monad, auto f)
+{
+    if(!monad.has_value())
+    {
+        // Return an empty maybe monad of the same type as if there
+        // was a value
+        return optional<remove_reference_t<decltype(*f(*monad))>>();
+    }
+
+    return f(*monad);
+}
+
+// The Pure function returns a maybe monad containing the value t
+auto Pure(auto t)
+{
+    return optional{t};
+}
+
+// A safe function to invert a value
+auto SafeInverse(double v)
+{
+    if (v == 0)
+    {
+        return optional<decltype(v)>();
+    }
+    else
+    {
+        return optional(1/v);
+    }
+}
+
+// A safe function to calculate the arc cosine
+auto SafeAcos(double v)
+{
+    if(v < -1 || v > 1)
+    {
+        // The input is out of range, return an empty monad
+        return optional<decltype(acos(v))>();
+    }
+    else
+    {
+        return optional(acos(v));
+    }
+}
+
+// Print the monad
+template<typename T>
+ostream& operator<<(ostream& s, optional<T> v)
+{
+    s << (v ? to_string(*v) : "nothing");
+    return s;
+}
+
+int main()
+{
+    // Use bind to compose SafeInverse and SafeAcos
+    vector<double> tests {-2.5, -1, -0.5, 0, 0.5, 1, 2.5};
+
+    cout << "x -> acos(1/x) , 1/(acos(x)\n";
+    for(auto v : tests)
+    {
+        auto maybeMonad = Pure(v);
+        auto inverseAcos = maybeMonad >> SafeInverse >> SafeAcos;
+        auto acosInverse = maybeMonad >> SafeAcos >> SafeInverse;
+        cout << v << " -> " << inverseAcos << ", " << acosInverse << "\n";
+    }
+}

Task/Monads-Maybe-monad/C-sharp/monads-maybe-monad.cs

@@ -0,0 +1,45 @@
+using System;
+
+namespace RosettaMaybe
+{
+    // courtesy of https://www.dotnetcurry.com/patterns-practices/1510/maybe-monad-csharp
+    public abstract class Maybe<T>
+    {
+        public sealed class Some : Maybe<T>
+        {
+            public Some(T value) => Value = value;
+            public T Value { get; }
+        }
+        public sealed class None : Maybe<T> { }
+    }
+
+    class Program
+    {
+        static Maybe<double> MonadicSquareRoot(double x)
+        {
+            if (x >= 0)
+            {
+                return new Maybe<double>.Some(Math.Sqrt(x));
+            }
+            else
+            {
+                return new Maybe<double>.None();
+            }
+        }
+        static void Main(string[] args)
+        {
+            foreach (double x in new double[] { 4.0D, 8.0D, -15.0D, 16.23D, -42 })
+            {
+                Maybe<double> maybe = MonadicSquareRoot(x);
+                if (maybe is Maybe<double>.Some some)
+                {
+                    Console.WriteLine($"The square root of {x} is " + some.Value);
+                }
+                else
+                {
+                    Console.WriteLine($"Square root of {x} is undefined.");
+                }
+            }
+        }
+    }
+}

Task/Monads-Maybe-monad/C/monads-maybe-monad.c

@@ -0,0 +1,124 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdbool.h>
+
+typedef enum type
+{
+  INT,
+  STRING
+} Type;
+
+typedef struct maybe
+{
+  int i;
+  char *s;
+  Type t;
+  _Bool is_something;
+} Maybe;
+
+void print_Maybe(Maybe *m)
+{
+  if (m->t == INT)
+    printf("Just %d : INT\n", m->i);
+
+  else if (m->t == STRING)
+    printf("Just \"%s\" : STRING\n", m->s);
+
+  else
+    printf("Nothing\n");
+
+}
+
+Maybe *return_maybe(void *data, Type t)
+{
+  Maybe *m = malloc(sizeof(Maybe));
+  if (t == INT)
+  {
+    m->i = *(int *) data;
+    m->s = NULL;
+    m->t = INT;
+    m->is_something = true;
+  }
+
+  else if (t == STRING)
+  {
+    m->i = 0;
+    m->s = data;
+    m->t = STRING;
+    m->is_something = true;
+  }
+
+  else
+  {
+    m->i = 0;
+    m->s = NULL;
+    m->t = 0;
+    m->is_something = false;
+  }
+
+  return m;
+}
+
+Maybe *bind_maybe(Maybe *m, Maybe *(*f)(void *))
+{
+  Maybe *n = malloc(sizeof(Maybe));
+
+  if (f(&(m->i))->is_something)
+  {
+    n->i = f(&(m->i))->i;
+    n->s = f(&(m->i))->s;
+    n->t = f(&(m->i))->t;
+    n->is_something = true;
+  }
+
+  else
+  {
+    n->i = 0;
+    n->s = NULL;
+    n->t = 0;
+    n->is_something = false;
+  }
+  return n;
+}
+
+Maybe *f_1(void *v) // Int -> Maybe Int
+{
+  Maybe *m = malloc(sizeof(Maybe));
+  m->i = (*(int *) v) * (*(int *) v);
+  m->s = NULL;
+  m->t = INT;
+  m->is_something = true;
+  return m;
+}
+
+Maybe *f_2(void *v) // :: Int -> Maybe String
+{
+  Maybe *m = malloc(sizeof(Maybe));
+  m->i = 0;
+  m->s = malloc(*(int *) v * sizeof(char) + 1);
+  for (int i = 0; i < *(int *) v; i++)
+  {
+    m->s[i] = 'x';
+  }
+  m->s[*(int *) v + 1] = '\0';
+  m->t = STRING;
+  m->is_something = true;
+  return m;
+}
+
+int main()
+{
+  int i = 7;
+  char *s = "lorem ipsum dolor sit amet";
+
+  Maybe *m_1 = return_maybe(&i, INT);
+  Maybe *m_2 = return_maybe(s, STRING);
+
+  print_Maybe(m_1); // print value of m_1: Just 49
+  print_Maybe(m_2); // print value of m_2 : Just "lorem ipsum dolor sit amet"
+
+  print_Maybe(bind_maybe(m_1, f_1)); // m_1 `bind` f_1 :: Maybe Int
+  print_Maybe(bind_maybe(m_1, f_2)); // m_1 `bind` f_2 :: Maybe String
+
+  print_Maybe(bind_maybe(bind_maybe(m_1, f_1), f_2)); // (m_1 `bind` f_1) `bind` f_2 :: Maybe String -- it prints 49 'x' characters in a row
+}

Task/Monads-Maybe-monad/Clojure/monads-maybe-monad.clj

@@ -0,0 +1,12 @@
+(defn bind [val f]
+  (if-let [v (:value val)] (f v) val))
+
+(defn unit [val] {:value val})
+
+(defn opt_add_3 [n] (unit (+ 3 n))) ; takes a number and returns a Maybe number
+(defn opt_str [n] (unit (str n)))   ; takes a number and returns a Maybe string
+
+(bind (unit 4) opt_add_3)                  ; evaluates to {:value 7}
+(bind (unit nil) opt_add_3)                ; evaluates to {:value nil}
+(bind (bind (unit 8) opt_add_3) opt_str)   ; evaluates to {:value "11"}
+(bind (bind (unit nil) opt_add_3) opt_str) ; evaluates to {:value nil}

Task/Monads-Maybe-monad/Delphi/monads-maybe-monad.delphi

@@ -0,0 +1,74 @@
+program Maybe_monad;
+
+{$APPTYPE CONSOLE}
+
+uses
+  System.SysUtils;
+
+type
+  TmList = record
+    Value: PInteger;
+    function ToString: string;
+    function Bind(f: TFunc<PInteger, TmList>): TmList;
+  end;
+
+function _Unit(aValue: Integer): TmList; overload;
+begin
+  Result.Value := GetMemory(sizeof(Integer));
+  Result.Value^ := aValue;
+end;
+
+function _Unit(aValue: PInteger): TmList; overload;
+begin
+  Result.Value := aValue;
+end;
+
+{ TmList }
+
+function TmList.Bind(f: TFunc<PInteger, TmList>): TmList;
+begin
+  Result := f(self.Value);
+end;
+
+function TmList.ToString: string;
+begin
+  if Value = nil then
+    Result := 'none'
+  else
+    Result := value^.ToString;
+end;
+
+function Decrement(p: PInteger): TmList;
+begin
+  if p = nil then
+    exit(_Unit(nil));
+  Result := _Unit(p^ - 1);
+end;
+
+function Triple(p: PInteger): TmList;
+begin
+  if p = nil then
+    exit(_Unit(nil));
+  Result := _Unit(p^ * 3);
+end;
+
+var
+  m1, m2: TmList;
+  i, a, b, c: Integer;
+  p: Tarray<PInteger>;
+
+begin
+  a := 3;
+  b := 4;
+  c := 5;
+  p := [@a, @b, nil, @c];
+
+  for i := 0 to High(p) do
+  begin
+    m1 := _Unit(p[i]);
+    m2 := m1.Bind(Decrement).Bind(Triple);
+
+    Writeln(m1.ToString: 4, ' -> ', m2.ToString);
+  end;
+  Readln;
+end.

Task/Monads-Maybe-monad/EchoLisp/monads-maybe-monad.l

@@ -0,0 +1,38 @@
+(define (Maybe.domain? x) (or (number? x) (string? x)))
+(define (Maybe.unit elem (bool #t)) (cons bool elem))
+
+;; f is a safe or unsafe function
+;; (Maybe.lift f) returns a safe Maybe function which returns a Maybe element
+(define (Maybe.lift f)
+		(lambda(x)
+             (let [(u (f x))]
+             (if (Maybe.domain? u)
+                (Maybe.unit u)
+                (Maybe.unit x #f))))) ;; return offending x
+
+
+;; elem = Maybe element
+;; f is safe or unsafe  (lisp) function
+;; return Maybe element
+(define (Maybe.bind f elem)
+		(if (first elem) ((Maybe.lift f)  (rest elem)) elem))
+		
+;; pretty-print		
+(define (Maybe.print elem)
+		(if (first elem)  (writeln elem ) (writeln '❌ elem)))
+
+;; unsafe functions
+(define (u-log x) (if (> x 0) (log x) #f))
+(define (u-inv x) (if (zero? x) 'zero-div (/ x)))
+
+;; (print (number->string (exp (log 3))))
+(->> 3 Maybe.unit (Maybe.bind u-log) (Maybe.bind exp)  (Maybe.bind number->string) Maybe.print)
+    → (#t . "3.0000000000000004")
+
+;; (print (number->string (exp (log -666))))
+(->> -666  Maybe.unit (Maybe.bind u-log) (Maybe.bind exp)  (Maybe.bind number->string) Maybe.print)
+     → ❌     (#f . -666)
+
+;; ;; (print (number->string (inverse (log 1))))
+(->> 1 Maybe.unit (Maybe.bind u-log)  (Maybe.bind u-inv)  (Maybe.bind number->string) Maybe.print)
+     →  ❌     (#f . 0)

Task/Monads-Maybe-monad/F-Sharp/monads-maybe-monad.fs

@@ -0,0 +1,8 @@
+// We can use Some as return, Option.bind and the pipeline operator in order to have a very concise code
+
+
+let f1 (v:int) = Some v  // int -> Option<int>
+let f2 (v:int) = Some(string v) // int -> Option<sting>
+
+f1 4 |> Option.bind f2 |> printfn "Value is %A"  // bind when option (maybe) has data
+None |> Option.bind f2 |> printfn "Value is %A" // bind when option (maybe) does not have data

Task/Monads-Maybe-monad/Factor/monads-maybe-monad-1.factor

@@ -0,0 +1,10 @@
+USING: monads ;
+FROM: monads => do ;
+
+! Prints "T{ just { value 7 } }"
+3 maybe-monad return >>= [ 2 * maybe-monad return ] swap call
+                     >>= [ 1 + maybe-monad return ] swap call .
+
+! Prints "nothing"
+nothing >>= [ 2 * maybe-monad return ] swap call
+        >>= [ 1 + maybe-monad return ] swap call .

Task/Monads-Maybe-monad/Factor/monads-maybe-monad-2.factor

@@ -0,0 +1,2 @@
+3 <just> [ 2 * <just> ] bind [ 1 + <just> ] bind .
+nothing [ 2 * <just> ] bind [ 1 + <just> ] bind .

Task/Monads-Maybe-monad/Factor/monads-maybe-monad-3.factor

@@ -0,0 +1,10 @@
+{
+    [ 3 <just> ]
+    [ 2 * <just> ]
+    [ 1 + <just> ]
+} do .
+{
+    [ nothing ]
+    [ 2 * <just> ]
+    [ 1 + <just> ]
+} do .

Task/Monads-Maybe-monad/Go/monads-maybe-monad.go

@@ -0,0 +1,50 @@
+package main
+
+import (
+    "fmt"
+    "strconv"
+)
+
+type maybe struct{ value *int }
+
+func (m maybe) bind(f func(p *int) maybe) maybe {
+    return f(m.value)
+}
+
+func unit(p *int) maybe {
+    return maybe{p}
+}
+
+func decrement(p *int) maybe {
+    if p == nil {
+        return unit(nil)
+    } else {
+        q := *p - 1
+        return unit(&q)
+    }
+}
+
+func triple(p *int) maybe {
+    if p == nil {
+        return unit(nil)
+    } else {
+        q := (*p) * 3
+        return unit(&q)
+    }
+}
+
+func main() {
+    i, j, k := 3, 4, 5
+    for _, p := range []*int{&i, &j, nil, &k} {
+        m1 := unit(p)
+        m2 := m1.bind(decrement).bind(triple)
+        var s1, s2 string = "none", "none"
+        if m1.value != nil {
+            s1 = strconv.Itoa(*m1.value)
+        }
+        if m2.value != nil {
+            s2 = strconv.Itoa(*m2.value)
+        }
+        fmt.Printf("%4s -> %s\n", s1, s2)
+    }
+}

Task/Monads-Maybe-monad/Haskell/monads-maybe-monad-1.hs

@@ -0,0 +1,2 @@
+main = do print $ Just 3 >>= (return . (*2)) >>= (return . (+1))  -- prints "Just 7"
+          print $ Nothing >>= (return . (*2)) >>= (return . (+1)) -- prints "Nothing"

Task/Monads-Maybe-monad/Haskell/monads-maybe-monad-2.hs

@@ -0,0 +1,8 @@
+main = do print (do x <- Just 3
+                    y <- return (x*2)
+                    z <- return (y+1)
+		    return z)
+          print (do x <- Nothing
+                    y <- return (x*2)
+                    z <- return (y+1)
+                    return z)

Task/Monads-Maybe-monad/Haskell/monads-maybe-monad-3.hs

@@ -0,0 +1,8 @@
+main = do print (do x <- Just 3
+                    let y = x*2
+                    let z = y+1
+		    return z)
+          print (do x <- Nothing
+                    let y = x*2
+                    let z = y+1
+                    return z)

Task/Monads-Maybe-monad/Haskell/monads-maybe-monad-4.hs

@@ -0,0 +1,13 @@
+import Control.Monad ((>=>))
+
+safeVersion :: (a -> b) -> (a -> Bool) -> a -> Maybe b
+safeVersion f fnSafetyCheck x | fnSafetyCheck x = Just (f x)
+                              | otherwise       = Nothing
+
+safeReciprocal = safeVersion (1/) (/=0)
+safeRoot = safeVersion sqrt (>=0)
+safeLog = safeVersion log (>0)
+
+safeLogRootReciprocal = safeReciprocal >=> safeRoot >=> safeLog
+
+main = print $ map safeLogRootReciprocal [-2, -1, -0.5, 0, exp (-1), 1, 2, exp 1, 3, 4, 5]

Task/Monads-Maybe-monad/Hoon/monads-maybe-monad.hoon

@@ -0,0 +1,19 @@
+:-  %say
+|=  [^ [[txt=(unit ,@tas) ~] ~]]
+:-  %noun
+|^
+  %+  biff  txt
+    ;~  biff
+      m-parse
+      m-double
+    ==
+  ++  m-parse
+    |=  a=@tas
+    ^-  (unit ,@ud)
+    (rust (trip a) dem)
+  ::
+  ++  m-double
+    |=  a=@ud
+    ^-  (unit ,@ud)
+    (some (mul a 2))
+  --

Task/Monads-Maybe-monad/J/monads-maybe-monad.j

@@ -0,0 +1,27 @@
+NB. monad implementation:
+unit=: <
+bind=: (@>)( :: ])
+
+NB. monad utility
+safeVersion=: (<@) ( ::((<_.)"_))
+safeCompose=:dyad define
+  dyad def 'x`:6 bind y'/x,unit y
+)
+
+NB. unsafe functions (fail with infinite arguments)
+subtractFromSelf=: -~
+divideBySelf=: %~
+
+NB. wrapped functions:
+safeSubtractFromSelf=: subtractFromSelf safeVersion
+safeDivideBySelf=: divideBySelf safeVersion
+
+NB. task example:
+     safeSubtractFromSelf bind safeDivideBySelf 1
+┌─┐
+│0│
+└─┘
+     safeSubtractFromSelf bind safeDivideBySelf _
+┌──┐
+│_.│
+└──┘

Task/Monads-Maybe-monad/Java/monads-maybe-monad.java

@@ -0,0 +1,29 @@
+import java.util.Optional;
+
+public final class MonadMaybe {
+
+	public static void main(String[] aArgs) {
+	    System.out.println(doubler(5).flatMap(MonadMaybe::stringify).get());
+	
+	    System.out.println(doubler(2).flatMap(MonadMaybe::stringifyNullable).get());
+	
+	    Optional<String> option = doubler(0).flatMap(MonadMaybe::stringifyNullable);
+	
+	    String result = option.isPresent() ? option.get() : "Result is Null";
+	
+	    System.out.println(result);
+	}
+	
+	private static Optional<Integer> doubler(int aN) {
+		return Optional.of(2 * aN);
+	}
+
+	private static Optional<String> stringify(int aN) {
+		return Optional.of("A".repeat(aN));
+	}
+
+	private static Optional<String> stringifyNullable(int aN) {
+		return ( aN > 0 ) ? Optional.ofNullable("A".repeat(aN)) : Optional.ofNullable(null);
+	}
+
+}

Task/Monads-Maybe-monad/JavaScript/monads-maybe-monad.js

@@ -0,0 +1,109 @@
+(function () {
+    'use strict';
+
+    // START WITH SOME SIMPLE (UNSAFE) PARTIAL FUNCTIONS:
+
+    // Returns Infinity if n === 0
+    function reciprocal(n) {
+        return 1 / n;
+    }
+
+    // Returns NaN if n < 0
+    function root(n) {
+        return Math.sqrt(n);
+    }
+
+    // Returns -Infinity if n === 0
+    // Returns NaN if n < 0
+    function log(n) {
+        return Math.log(n);
+    }
+
+
+    // NOW DERIVE SAFE VERSIONS OF THESE SIMPLE FUNCTIONS:
+    // These versions use a validity test, and return a wrapped value
+    // with a boolean .isValid property as well as a .value property
+
+    function safeVersion(f, fnSafetyCheck) {
+        return function (v) {
+            return maybe(fnSafetyCheck(v) ? f(v) : undefined);
+        }
+    }
+
+    var safe_reciprocal = safeVersion(reciprocal, function (n) {
+        return n !== 0;
+    });
+
+    var safe_root = safeVersion(root, function (n) {
+        return n >= 0;
+    });
+
+
+    var safe_log = safeVersion(log, function (n) {
+        return n > 0;
+    });
+
+
+    // THE DERIVATION OF THE SAFE VERSIONS USED THE 'UNIT' OR 'RETURN'
+    // FUNCTION OF THE MAYBE MONAD
+
+    // Named maybe() here, the unit function of the Maybe monad wraps a raw value
+    // in a datatype with two elements: .isValid (Bool) and .value (Number)
+
+    // a -> Ma
+    function maybe(n) {
+        return {
+            isValid: (typeof n !== 'undefined'),
+            value: n
+        };
+    }
+
+    // THE PROBLEM FOR FUNCTION NESTING (COMPOSITION) OF THE SAFE FUNCTIONS
+    // IS THAT THEIR INPUT AND OUTPUT TYPES ARE DIFFERENT
+
+    // Our safe versions of the functions take simple numeric arguments, but return
+    // wrapped results. If we feed a wrapped result as an input to another safe function,
+    // it will choke on the unexpected type. The solution is to write a higher order
+    // function (sometimes called 'bind' or 'chain') which handles composition, taking a
+    // a safe function and a wrapped value as arguments,
+
+    // The 'bind' function of the Maybe monad:
+    // 1. Applies a 'safe' function directly to the raw unwrapped value, and
+    // 2. returns the wrapped result.
+
+    // Ma -> (a -> Mb) -> Mb
+    function bind(maybeN, mf) {
+        return (maybeN.isValid ? mf(maybeN.value) : maybeN);
+    }
+
+    // Using the bind function, we can nest applications of safe_ functions,
+    // without their choking on unexpectedly wrapped values returned from
+    // other functions of the same kind.
+    var rootOneOverFour = bind(
+        bind(maybe(4), safe_reciprocal), safe_root
+    ).value;
+
+    // -> 0.5
+
+
+    // We can compose a chain of safe functions (of any length) with a simple foldr/reduceRight
+    // which starts by 'lifting' the numeric argument into a Maybe wrapping,
+    // and then nests function applications (working from right to left)
+    function safeCompose(lstFunctions, value) {
+        return lstFunctions
+            .reduceRight(function (a, f) {
+                return bind(a, f);
+            }, maybe(value));
+    }
+
+    // TEST INPUT VALUES WITH A SAFELY COMPOSED VERSION OF LOG(SQRT(1/X))
+
+    var safe_log_root_reciprocal = function (n) {
+        return safeCompose([safe_log, safe_root, safe_reciprocal], n).value;
+    }
+
+    return [-2, -1, -0.5, 0, 1 / Math.E, 1, 2, Math.E, 3, 4, 5].map(
+        safe_log_root_reciprocal
+    );
+
+})();

Task/Monads-Maybe-monad/Julia/monads-maybe-monad.julia

@@ -0,0 +1,16 @@
+struct maybe x::Union{Real, Missing}; end
+
+Base.show(io::IO, m::maybe) = print(io, m.x)
+
+unit(x) = maybe(x)
+bind(f, x) = unit(f(x.x))
+
+f1(x) = 5x
+f2(x) = x + 4
+
+a = unit(3)
+b = unit(missing)
+
+println(a, " -> ", bind(f2, bind(f1, a)))
+
+println(b, " -> ", bind(f2, bind(f1, b)))

Task/Monads-Maybe-monad/Kotlin/monads-maybe-monad.kotlin

@@ -0,0 +1,24 @@
+// version 1.2.10
+
+import java.util.Optional
+
+/* doubles 'i' before wrapping it */
+fun getOptionalInt(i: Int) = Optional.of(2 * i)
+
+/* returns an 'A' repeated 'i' times wrapped in an Optional<String> */
+fun getOptionalString(i: Int) = Optional.of("A".repeat(i))
+
+/* does same as above if i > 0, otherwise returns an empty Optional<String> */
+fun getOptionalString2(i: Int) =
+   Optional.ofNullable(if (i > 0) "A".repeat(i) else null)
+
+fun main(args: Array<String>) {
+    /* prints 10 'A's */
+    println(getOptionalInt(5).flatMap(::getOptionalString).get())
+
+    /* prints  4 'A's */
+    println(getOptionalInt(2).flatMap(::getOptionalString2).get())
+
+    /* prints 'false' as there is no value present in the Optional<String> instance */
+    println(getOptionalInt(0).flatMap(::getOptionalString2).isPresent)
+}

Task/Monads-Maybe-monad/Lua/monads-maybe-monad.lua

@@ -0,0 +1,80 @@
+-- None is represented by an empty table.  Some is represented by any
+-- array with one element.  You SHOULD NOT compare maybe values with the
+-- Lua operator == because it will give incorrect results.  Use the
+-- functions isMaybe(), isNone(), and isSome().
+
+-- define once for efficiency, to avoid many different empty tables
+local NONE = {}
+
+local function unit(x) return { x } end
+local Some = unit
+local function isNone(mb) return #mb == 0 end
+local function isSome(mb) return #mb == 1 end
+local function isMaybe(mb) return isNone(mb) or isSome(mb) end
+
+-- inverse of Some(), extract the value from the maybe; get(Some(x)) === x
+local function get(mb) return mb[1] end
+
+function maybeToStr(mb)
+	return isNone(mb) and "None" or ("Some " .. tostring(get(mb)))
+end
+
+local function bind(mb, ...)  -- monadic bind for multiple functions
+	local acc = mb
+	for _, fun in ipairs({...}) do  -- fun should be a monadic function
+		assert(type(fun) == "function")
+		if isNone(acc) then return NONE
+		else acc = fun(get(acc)) end
+	end
+	return acc
+end
+
+local function fmap(mb, ...)  -- monadic fmap for multiple functions
+	local acc = mb
+	for _, fun in ipairs({...}) do  -- fun should be a regular function
+		assert(type(fun) == "function")
+		if isNone(acc) then return NONE
+		else acc = Some(fun(get(acc))) end
+	end
+	return acc
+end
+-- ^^^ End of generic maybe monad functionality ^^^
+
+--- vvv Start of example code vvv
+
+local function time2(x) return x * 2 end
+local function plus1(x) return x + 1 end
+
+local answer
+answer = fmap(Some(3), time2, plus1, time2)
+assert(get(answer)==14)
+
+answer = fmap(NONE, time2, plus1, time2)
+assert(isNone(answer))
+
+local function safeReciprocal(x)
+	if x ~= 0 then return Some(1/x) else return NONE end
+end
+local function safeRoot(x)
+	if x >= 0 then return Some(math.sqrt(x)) else return NONE end
+end
+local function safeLog(x)
+	if x > 0 then return Some(math.log(x)) else return NONE end
+end
+local function safeComputation(x)
+	return bind(safeReciprocal(x), safeRoot, safeLog)
+end
+
+local function map(func, table)
+	local result = {}
+	for key, val in pairs(table) do
+		result[key] = func(val)
+	end
+	return result
+end
+
+local inList = {-2, -1, -0.5, 0, math.exp (-1), 1, 2, math.exp (1), 3, 4, 5}
+print("input:", table.concat(map(tostring, inList), ",  "), "\n")
+
+local outList = map(safeComputation, inList)
+print("output:", table.concat(map(maybeToStr, outList), ",  "), "\n")

Task/Monads-Maybe-monad/M2000-Interpreter/monads-maybe-monad-1.m2000

@@ -0,0 +1,69 @@
+Class maybe {
+private:
+	variant [val]="none"
+	boolean haveValue
+public:
+	property val {
+		value  // val return the [val] value
+	}
+	function bind(f) {
+		m=This  // we can read private because bind is function of same class as m
+		if m.haveValue Then m.[val]=f(m.[val])
+		=m // copy (not pointer)
+	}
+	Operator "=" (z as maybe) {
+		if z.havevalue xor .havevalue then
+			push false
+		else
+			Push z.[val]=.[val]
+		end if
+	}
+	Function unit() {
+		variant k
+		if match("G") then  // so we can read maybe class
+			read g as maybe // fail if not maybe class
+	 		if g.havevalue then push g.val
+	 	end if
+		Read ? k
+		m=This
+		if not type$(k)="Empty" then
+			integer v=k  ' fail if k can't convert to integer
+			m.[val]=v
+			m.haveValue=true
+		else  // so now we can produce "none" from an object which isn't "none"
+			m.[val]="none"
+			m.haveValue=false
+		end if
+		=m // copy (not pointer)
+	}
+class:
+	// after class: all are temporary for the constuction phase
+	// module with class name is the contructor
+	// the object constracted before enter this module
+	// but we can change it. So we return a new one.
+	module maybe {
+		// so the constructor is the same as the .unit
+		// ![] pick argument list and place to unit()
+		// optionally we can skip the call if we have empty argument list
+		if not empty then
+			this=.unit(![])
+		end if
+	}
+}
+none=maybe()
+decrement =lambda (x as integer)->x-1%
+triple =lambda (x as integer)->x*3%
+variant emptyvariant
+// 3 and 4 are double, 5 is integer type
+SetA=(3,4,none,5%, emptyvariant, none.unit())
+k=each(SetA)
+While K
+	m1=none.unit(array(k))  // pick element k^
+	m2=m1.bind(decrement).bind(triple)
+	m3=maybe(m2)
+	Print m1.val+" -> "+m2.val, m3=m2, m3.val	
+End While
+Try ok {
+	m5=maybe("Hello")
+}
+Print not ok // true , "Hello" not accepted

Task/Monads-Maybe-monad/M2000-Interpreter/monads-maybe-monad-2.m2000

@@ -0,0 +1,66 @@
+Class maybe {
+private:
+	variant [val]="none"
+	boolean haveValue
+public:
+	property val {
+		value  // val return the [val] value
+	}
+	function bind(f) {
+		m=This  // we can read private because bind is function of same class as m
+		if m.haveValue Then m.[val]=f(m.[val])
+		->(m) // pointer
+	}
+	Operator "=" (z as maybe) {
+		if z.havevalue xor .havevalue then
+			push false
+		else
+			Push z.[val]=.[val]
+		end if
+	}
+	Function unit() {
+		variant k
+		if match("G") then  // so we can read maybe class
+			read g as maybe // fail if not maybe class
+	 		if g.havevalue then push g.val
+	 	end if
+		Read ? k
+		m=This
+		if not type$(k)="Empty" then
+			integer v=k  ' fail if k can't convert to integer
+			m.[val]=v
+			m.haveValue=true
+		else  // so now we can produce "none" from an object which isn't "none"
+			m.[val]="none"
+			m.haveValue=false
+		end if
+		->(m) // pointer
+	}
+class:
+	module maybe {
+		if not empty then
+			this=.unit(![])
+		end if
+	}
+}
+none->maybe()
+decrement =lambda (x as integer)->x-1%
+triple =lambda (x as integer)->x*3%
+variant emptyvariant
+SetA=(3,4,none,5%, emptyvariant, none=>unit())
+k=each(SetA)
+document doc$
+While k
+	m1=none=>unit(array(k))  // pick element k^
+	m2=m1=>bind(decrement)=>bind(triple)
+	m3=maybe(m2)
+      doc$=m1=>val+" -> "+m2=>val+" m2=m3 -> "+if$(m2=m3->"True", "False")+{
+      }
+End While
+Try ok {
+	m5=maybe("Hello")
+}
+Doc$= (not ok)+{
+}  // true , "Hello" not accepted
+report doc$
+clipboard doc$

Task/Monads-Maybe-monad/Nim/monads-maybe-monad.nim

@@ -0,0 +1,25 @@
+import options,math,sugar,strformat
+template checkAndWrap(x:float,body:typed): untyped =
+  if x.classify in {fcNormal,fcZero,fcNegZero}:
+    some(body)
+  else:
+    none(typeof(body))
+func reciprocal(x:float):Option[float] =
+  let res = 1 / x
+  res.checkAndWrap(res)
+func log(x:float):Option[float] =
+  let res = ln(x)
+  res.checkAndWrap(res)
+func format(x:float):Option[string] =
+  x.checkAndWrap(&"{x:.2f}")
+
+#our bind function:
+func `-->`[T,U](input:Option[T], f: T->Option[U]):Option[U] =
+  if input.isSome:
+    f(input.get)
+  else:
+    none(U)
+
+when isMainModule:
+  for i in [0.9,0.0,-0.9,3.0]:
+    echo some(i) --> reciprocal --> log --> format

Task/Monads-Maybe-monad/OCaml/monads-maybe-monad-1.ocaml

@@ -0,0 +1,5 @@
+let bind opt func = match opt with
+  | Some x -> func x
+  | None -> None
+
+let return x = Some x

Task/Monads-Maybe-monad/OCaml/monads-maybe-monad-2.ocaml

@@ -0,0 +1,5 @@
+let (-->) = bind
+let (let*) = bind
+
+let print_str_opt x =
+  Format.printf "%s" (Option.value ~default:"None" x)

Task/Monads-Maybe-monad/OCaml/monads-maybe-monad-3.ocaml

@@ -0,0 +1,21 @@
+let safe_div x y = if y = 0.0 then None else return (x /. y)
+let safe_root x = if x < 0.0 then None else return (sqrt x)
+let safe_str x = return (Format.sprintf "%#f" x)
+
+(* Version 1 : explicit calls *)
+let () =
+  let v = bind (bind (safe_div 5. 3.) safe_root) safe_str in
+  print_str_opt v
+
+(* Version 2 : with an operator *)
+let () =
+  let v = safe_div 5. 3. --> safe_root --> safe_str in
+  print_str_opt v
+
+(* Version 3 : let pruning really shine when inlining functions *)
+let () =
+  let v =
+    let* x = safe_div 5. 3. in
+    let* y = if x < 0.0 then None else return (sqrt x) in
+    return (Format.sprintf "%#f" y)
+  in print_str_opt v

Task/Monads-Maybe-monad/Perl/monads-maybe-monad.pl

@@ -0,0 +1,19 @@
+# 20201101 added Perl programming solution
+
+use strict;
+use warnings;
+
+use Data::Monad::Maybe;
+
+sub safeReciprocal { ( $_[0] == 0 ) ? nothing : just(  1 /  $_[0] )   }
+
+sub safeRoot       { ( $_[0] <  0 ) ? nothing : just( sqrt( $_[0] ) ) }
+
+sub safeLog        { ( $_[0] <= 0 ) ? nothing : just( log ( $_[0] ) ) }
+
+print join(' ', map {
+   my $safeLogRootReciprocal = just($_)->flat_map( \&safeReciprocal )
+                                       ->flat_map( \&safeRoot       )
+                                       ->flat_map( \&safeLog        );
+   $safeLogRootReciprocal->is_nothing ? "NaN" : $safeLogRootReciprocal->value;
+} (-2, -1, -0.5, 0, exp (-1), 1, 2, exp(1), 3, 4, 5) ), "\n";

Task/Monads-Maybe-monad/Phix/monads-maybe-monad.phix

@@ -0,0 +1,23 @@
+(phixonline)-->
+ <span style="color: #008080;">function</span> <span style="color: #000000;">bindf</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">)</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">unit</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">m</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">times_five</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">l</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">return</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span><span style="color: #0000FF;">(</span><span style="color: #000000;">l</span><span style="color: #0000FF;">)?</span><span style="color: #000000;">l</span><span style="color: #0000FF;">*</span><span style="color: #000000;">5</span><span style="color: #0000FF;">:</span><span style="color: #000000;">l</span><span style="color: #0000FF;">)</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">plus_four</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">l</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">return</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span><span style="color: #0000FF;">(</span><span style="color: #000000;">l</span><span style="color: #0000FF;">)?</span><span style="color: #000000;">l</span><span style="color: #0000FF;">+</span><span style="color: #000000;">4</span><span style="color: #0000FF;">:</span><span style="color: #000000;">l</span><span style="color: #0000FF;">)</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">procedure</span> <span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">l</span><span style="color: #0000FF;">)</span>
+     <span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%v -&gt; %v\n"</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">bindf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bindf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">l</span><span style="color: #0000FF;">,</span><span style="color: #000000;">times_five</span><span style="color: #0000FF;">),</span><span style="color: #000000;">plus_four</span><span style="color: #0000FF;">)})</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
+ <span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #000000;">3</span><span style="color: #0000FF;">)</span>
+ <span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"none"</span><span style="color: #0000FF;">)</span>
+<!--

Task/Monads-Maybe-monad/Python/monads-maybe-monad.py

@@ -0,0 +1,52 @@
+"""A Maybe Monad. Requires Python >= 3.7 for type hints."""
+from __future__ import annotations
+
+from typing import Any
+from typing import Callable
+from typing import Generic
+from typing import Optional
+from typing import TypeVar
+from typing import Union
+
+
+T = TypeVar("T")
+
+
+class Maybe(Generic[T]):
+    def __init__(self, value: Union[Optional[T], Maybe[T]] = None):
+        if isinstance(value, Maybe):
+            self.value: Optional[T] = value.value
+        else:
+            self.value = value
+
+    def __rshift__(self, func: Callable[[Optional[T]], Maybe[Any]]):
+        return self.bind(func)
+
+    def bind(self, func: Callable[[Optional[T]], Maybe[Any]]) -> Maybe[Any]:
+        return func(self.value)
+
+    def __str__(self):
+        return f"{self.__class__.__name__}({self.value!r})"
+
+
+def plus_one(value: Optional[int]) -> Maybe[int]:
+    if value is not None:
+        return Maybe[int](value + 1)
+    return Maybe[int](None)
+
+
+def currency(value: Optional[int]) -> Maybe[str]:
+    if value is not None:
+        return Maybe[str](f"${value}.00")
+    return Maybe[str](None)
+
+
+if __name__ == "__main__":
+    test_cases = [1, 99, None, 4]
+
+    for case in test_cases:
+        m_int = Maybe[int](case)
+        result = m_int >> plus_one >> currency
+        # or..
+        # result = m_int.bind(plus_one).bind(currency)
+        print(f"{str(case):<4} -> {result}")

Task/Monads-Maybe-monad/REXX/monads-maybe-monad.rexx

@@ -0,0 +1,24 @@
+/*REXX program mimics a bind operation when trying to perform addition upon arguments.  */
+call add 1, 2
+call add 1, 2.0
+call add 1, 2.0, -6
+call add self, 2
+exit 0                                           /*stick a fork in it,  we're all done. */
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+add:   void= 'VOID';                       f=    /*define in terms of a function&binding*/
+                     do j=1  for arg()           /*process, classify, bind each argument*/
+                     call bind( arg(j) );  f= f arg(j)
+                     end   /*j*/
+       say
+       say 'adding'  f;    call sum f            /*telegraph what's being performed next*/
+       return                                    /*Note: REXX treats INT & FLOAT as num.*/
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+bind:  arg a;  type.a= datatype(a);  return      /*bind argument's kind with its "type".*/
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+sum:   parse arg a;  $= 0                        /*sum all arguments that were specified*/
+                             do k=1  for words(a);  ?= word(a, k)
+                             if type.?==num & $\==void  then $= ($ + word(a, k)) / 1
+                                                        else $= void
+                             end   /*k*/
+       say 'sum='  $
+       return $

Task/Monads-Maybe-monad/Racket/monads-maybe-monad.rkt

@@ -0,0 +1,38 @@
+#lang racket
+
+(require syntax/parse/define)
+
+(define (bind x f) (and x (f x)))
+(define return identity)
+
+;; error when arg = 0
+(define reciprocal (curry / 1))
+;; error when arg < 0
+(define (root x) (if (< x 0) (error 'bad) (sqrt x)))
+;; error whe  arg <= 0
+(define (ln x) (if (<= x 0) (error 'bad) (log x)))
+
+(define (lift f check) (λ (x) (and (check x) (f x))))
+
+(define safe-reciprocal (lift reciprocal (negate (curry equal? 0))))
+(define safe-root (lift root (curry <= 0)))
+(define safe-ln (lift ln (curry < 0)))
+
+(define (safe-log-root-reciprocal x)
+  (bind (bind (bind x safe-reciprocal) safe-root) safe-ln))
+
+(define tests `(-2 -1 -0.5 0 1 ,(exp -1) 1 2 ,(exp 1) 3 4 5))
+
+(map safe-log-root-reciprocal tests)
+
+(define-syntax-parser do-macro
+  [(_ [x {~datum <-} y] . the-rest) #'(bind y (λ (x) (do-macro . the-rest)))]
+  [(_ e) #'e])
+
+(define (safe-log-root-reciprocal* x)
+  (do-macro [x <- (safe-reciprocal x)]
+            [x <- (safe-root x)]
+            [x <- (safe-ln x)]
+            (return x)))
+
+(map safe-log-root-reciprocal* tests)

Task/Monads-Maybe-monad/Raku/monads-maybe-monad-1.raku

@@ -0,0 +1,4 @@
+my $monad = <42>;
+say 'Is $monad an Int?: ', $monad ~~ Int;
+say 'Is $monad a  Str?: ', $monad ~~ Str;
+say 'Wait, what? What exactly is $monad?: ', $monad.^name;

Task/Monads-Maybe-monad/Raku/monads-maybe-monad-2.raku

@@ -0,0 +1,44 @@
+# Build a Nothing type. When treated as a string it returns the string 'Nothing'.
+# When treated as a Numeric, returns the value 'Nil'.
+class NOTHING {
+    method Str { 'Nothing' }
+    method Numeric { Nil }
+}
+
+# A generic instance of a Nothing type.
+my \Nothing = NOTHING.new;
+
+# A reimplementation of the square-root function. Could just use the CORE one
+# but this more fully shows how multi-dispatch candidates are added.
+
+# Handle positive numbers & 0
+multi root (Numeric $n where * >= 0) { $n.sqrt }
+# Handle Negative numbers (Complex number handling is built in.)
+multi root (Numeric $n where * <  0) { $n.Complex.sqrt }
+# Else return Nothing
+multi root ($n) { Nothing }
+
+# Handle numbers > 0
+multi ln (Real $n where * > 0) { log $n, e }
+# Else return Nothing
+multi ln ($n) { Nothing }
+
+# Handle fraction where the denominator != 0
+multi recip (Numeric $n where * != 0) { 1/$n }
+# Else return Nothing
+multi recip ($n) { Nothing }
+
+# Helper formatting routine
+sub center ($s) {
+    my $pad = 21 - $s.Str.chars;
+    ' ' x ($pad / 2).floor ~ $s ~ ' ' x ($pad / 2).ceiling;
+}
+
+# Display the "number" the reciprocal, the root, natural log and the 3 functions
+# composed together.
+put ('"Number"', 'Reciprocal', 'Square root', 'Natural log', 'Composed')».&center;
+
+# Note how it handles the last two "values". The string 'WAT' is not numeric at
+# all; but Ethiopic number 30, times vulgar fraction 1/7, is.
+put ($_, .&recip, .&root, .&ln, .&(&ln o &root o &recip) )».&center
+  for -2, -1, -0.5, 0, exp(-1), 1, 2, exp(1), 3, 4, 5, 'WAT', ፴ × ⅐;

Task/Monads-Maybe-monad/Ruby/monads-maybe-monad.rb

@@ -0,0 +1,48 @@
+class Maybe
+  def initialize(value)
+    @value = value
+  end
+
+  def map
+    if @value.nil?
+      self
+    else
+      Maybe.new(yield @value)
+    end
+  end
+end
+
+Maybe.new(3).map { |n| 2*n }.map { |n| n+1 }
+#=> #<Maybe @value=7>
+
+Maybe.new(nil).map { |n| 2*n }.map { |n| n+1 }
+#=> #<Maybe @value=nil>
+
+Maybe.new(3).map { |n| nil }.map { |n| n+1 }
+#=> #<Maybe @value=nil>
+
+# alias Maybe#new and write bind to be in line with task
+
+class Maybe
+  class << self
+    alias :unit :new
+  end
+
+  def initialize(value)
+    @value = value
+  end
+
+  def bind
+    if @value.nil?
+      self
+    else
+      yield @value
+    end
+  end
+end
+
+Maybe.unit(3).bind { |n| Maybe.unit(2*n) }.bind { |n| Maybe.unit(n+1) }
+#=> #<Maybe @value=7>
+
+Maybe.unit(nil).bind { |n| Maybe.unit(2*n) }.bind { |n| Maybe.unit(n+1) }
+#=> #<Maybe @value=nil>

Task/Monads-Maybe-monad/Rust/monads-maybe-monad.rust

@@ -0,0 +1,56 @@
+use std::collections::HashMap;
+
+/// Returns the arithmetic square root of x, if it exists
+fn arithmetic_square_root(x: u8) -> Option<u8> {
+    // the number of perfect squares for u8 is so low you can just fit the entire list in memory
+    let perfect_squares: HashMap<u8, u8> = HashMap::from([
+        (0, 0),
+        (1, 1),
+        (4, 2),
+        (9, 3),
+        (16, 4),
+        (25, 5),
+        (36, 6),
+        (49, 7),
+        (64, 8),
+        (81, 9),
+        (100, 10),
+        (121, 11),
+        (144, 12),
+        (169, 13),
+        (196, 14),
+        (225, 15),
+    ]);
+
+    // `HashMap::<K, V>::get(&self, &Q)` also returns a `Option<&V>`, we then turn it to `Option<V>`
+    perfect_squares.get(&x).copied()
+}
+
+
+/// If x in base 10 is also a valid number when looking upside down, return a string slice for that
+/// number upside down
+fn upside_down_num(x: u8) -> Option<&'static str> {
+    match x {
+        0 => Some("0"),
+        1 => Some("1"),
+        6 => Some("9"),
+        8 => Some("8"),
+        9 => Some("6"),
+        10 => Some("01"),
+        11 => Some("11"),
+        16 => Some("91"),
+        _ => None
+    }
+}
+
+fn main() {
+    // if the number from 0 to 36 inclusive, is a perfect square and its square root is also a
+    // valid number when looking upside down, then we will get a Some containing the string slice,
+    // otherwise we get a None, indicating it's not a perfect square or the square root is not a
+    // valid number while looking upside down
+    (0..=36)
+        .map(|x| arithmetic_square_root(x).and_then(upside_down_num))
+        .enumerate()
+        .for_each(|(i, upside_down_square_root)|
+            println!("i = {i:02}, upside down square root = {upside_down_square_root:?}"));
+}

Task/Monads-Maybe-monad/Swift/monads-maybe-monad.swift

@@ -0,0 +1,43 @@
+precedencegroup MonadPrecedence {
+	higherThan: BitwiseShiftPrecedence
+	associativity: left
+}
+
+infix operator >>-: MonadPrecedence	// Monadic bind
+
+typealias Maybe = Optional
+
+extension Maybe
+{
+	static func unit(_ x: Wrapped) -> Maybe<Wrapped>
+	{
+		return Maybe(x)
+	}
+
+	func bind<T>(_ f: (Wrapped) -> Maybe<T>) -> Maybe<T>
+	{
+		return self.flatMap(f)
+	}
+
+	static func >>- <U>(_ m: Optional<Wrapped>, _ f: (Wrapped) -> Maybe<U>) -> Maybe<U>
+	{
+		return m.flatMap(f)
+	}
+}
+
+func dividedBy2IfEven(_ x: Int) -> Maybe<Int>
+{
+	x.isMultiple(of: 2) ? x / 2 : nil
+}
+
+func lineOfAs(_ x: Int) -> Maybe<String>
+{
+	guard x >= 0 else { return nil }
+	let chars = Array<Character>(repeating: "A", count: x)
+	return String(chars)
+}
+
+print("\(Maybe.unit(6).bind(dividedBy2IfEven).bind(lineOfAs) ?? "nil")")
+print("\(Maybe.unit(4) >>- dividedBy2IfEven >>- lineOfAs ?? "nil")")
+print("\(Maybe.unit(3) >>- dividedBy2IfEven >>- lineOfAs ?? "nil")")
+print("\(Maybe.unit(-4) >>- dividedBy2IfEven >>- lineOfAs ?? "nil")")

Task/Monads-Maybe-monad/Wren/monads-maybe-monad.wren

@@ -0,0 +1,31 @@
+import "/fmt" for Fmt
+
+class Maybe {
+    construct new(value) {
+        _value = value
+    }
+
+    value { _value }
+
+    bind(f) { f.call(_value) }
+
+    static unit(i) { Maybe.new(i) }
+}
+
+var decrement = Fn.new { |i|
+    if (!i) return Maybe.unit(null)
+    return Maybe.unit(i - 1)
+}
+
+var triple = Fn.new { |i|
+    if (!i) return Maybe.unit(null)
+    return Maybe.unit(3 * i)
+}
+
+for (i in [3, 4, null, 5]) {
+    var m1 = Maybe.unit(i)
+    var m2 = m1.bind(decrement).bind(triple)
+    var s1 = (m1.value) ? "%(m1.value)" : "none"
+    var s2 = (m2.value) ? "%(m2.value)" : "none"
+    System.print("%(Fmt.s(4, s1)) -> %(s2)")
+}

Task/Monads-Maybe-monad/Zkl/monads-maybe-monad-1.zkl

@@ -0,0 +1,3 @@
+fcn bind(a,type,b){ if(type.isType(a)) b else Void }
+fcn just(x){ if(Deferred.isType(x)) x() else x }  // force lazy evaluation
+fcn rtn(x) { just(x) }

Task/Monads-Maybe-monad/Zkl/monads-maybe-monad-2.zkl

@@ -0,0 +1,8 @@
+fcn add(mx,my){
+   bind(mx,Int,
+      bind(my,Int,
+        '+.fp(mx,my))) : rtn(_)  // create a lazy mx+my to avoid eager eval
+}
+add(1,2).println();    // two ints
+add(1,2.0).println();  // int and float
+add(self,2).println(); // class and int