シェルスクリプトでMaybeモナド

Maybe.hs

db :: [(String, [(String, String)])]
db = [("alice", [("title", "Ms."), ("job", "sales")]),
  ("bob",   [("title", "Mr."), ("job", "engineer")])]

monad :: Maybe String
monad = return db >>= lookup "bob" >>= lookup "job"

main :: IO()
main = print monad
-- Just "engineer"

Maybe_fail.hs

db :: [(String, [(String, String)])]
db = [("alice", [("title", "Ms."), ("job", "sales")]),
  ("bob",   [("title", "Mr."), ("job", "engineer")])]

monad :: Maybe String
monad = return db >>= lookup "chris" >>= lookup "job"

main :: IO()
main = print monad
-- Nothing

maybe_func.sh

function maybe_ls(){
  local output
  output=$(ls "$@")
  if [ $? = 0 ]; then
    Just $output
    return 0
  else
    Nothing
    return 1
  fi
}

function maybe_cat(){
  local output
  output=$(cat "$@")
  if [ $? = 0 ]; then
    Just $output
    return 0
  else
    Nothing
    return 1
  fi
}

function maybe_touch(){
  local output
  touch "$@"
  if [ $? = 0 ]; then
    Just $@
    return 0
  else
    Nothing
    return 1
  fi
}

function maybe_add_line(){
  local add_string=$1
  local file_name=$2
  echo $add_string >> $file_name
  if [ $? = 0 ]; then
    Just $file_name
    return 0
  else
    Nothing
    return 1
  fi
}

monad.sh

#!/bin/bash

function Just(){
  echo "$@"
  return 0
}

function Nothing(){
  echo Nothing
  return 1
}

function ret(){
  Just "$@"
  return 0
}

function bind(){
  local std_in
  local std_out
  read std_in
  if expr "$std_in" : "^Nothing$" >/dev/null;then
    Nothing
    return 1
  else
    std_out=`eval $1 $std_in`
    if [ $? = 1 ];then
      Nothing
      return 1
    else
      Just "$std_out"
      return 0
    fi
  fi
}

# ユーティリティ
# パイプの最後につなげることで現在の値がNothingかJustかが分かる
function show(){
  local std_in
  read std_in
  if expr "$std_in" : "^Nothing$" >/dev/null;then
    echo Nothing
    return 1
  else
    echo "Just $std_in"
    return 0
  fi
}

monad_law.hs

(return x) >>= f == f x
m >>= return == m
(m >>= f) >>= g == m >>= (\x -> f x >>= g)

monad_law.sh

$((ret x) | bind "f") と $(f $(echo x)) が等しい
$(echo m | bind "ret") と $(echo m) が等しい
$((echo m | bind "f") | bind "g") と $(echo m | bind (\x -> f x >>= gのような関数)) が等しい

monad_law1.sh

source monad.sh

echo モナド則テスト1
test $(ret monad.sh | bind "maybe_ls") = $(maybe_ls $( echo monad.sh))
echo $?
# -> 0

test $(ret noexist | bind "maybe_ls" | bind "maybe_cat") = $(maybe_ls $(echo noexist))
echo $?
# -> 0

monad_law2.sh

source monad.sh

echo モナド則テスト2
test $(echo monad.sh | bind "ret") = $(echo monad.sh)
echo $?
# -> 0

test $(Nothing | bind "ret") =  $(Nothing)
echo $?
# -> 0

monad_law3.sh

source monad.sh

echo モナド則テスト3
function tmp_func(){
  eval "$1" "$3" 2>/dev/null | bind "$2"
}
test "$((echo monad.sh | bind "maybe_ls") | bind "maybe_cat")" = "$(echo monad.sh | bind "tmp_func maybe_ls maybe_cat")"
echo $?
# -> 0

test "$((echo nothing | bind "maybe_ls") | bind "maybe_cat")" = "$(echo nothing | bind "tmp_func maybe_ls maybe_cat")"
echo $?
# -> 0