Cacher is the code snippet organizer for pro developers

Working through Why is a Monad Like a Writing Desk

Talk by Carin Meier @gigasquid

http://www.infoq.com/presentations/Why-is-a-Monad-Like-a-Writing-Desk

But in Groovy

The door

def mreturn = { mv ->
    { -> mv }
}

assert mreturn( 'hello' )() == 'hello'

def bind = { mv, f ->
    f( mv() )
}

def withToast = { s ->
    mreturn( "toast & $s" )
}

assert bind( mreturn( 'jelly' ), withToast )() == 'toast & jelly'

def grow = { s ->
    mreturn( s + s[-1] )
}

assert grow( 'me' )() == 'mee'

def mgrow = { mv ->
    bind( mv, grow )
}

assert mgrow( mreturn( 'me' ) )() == 'mee'

assert mgrow( mgrow( mgrow( mreturn( 'me' ) ) ) )() == 'meeee'

The forest

def directions = { start ->
    mreturn( "$start: ${( Math.random() > 0.5 ) ? 'right' : 'left'}" )
}

def mdirections = { mv ->
    bind( mv, directions )
}

assert mdirections( mdirections( mreturn( 'here' ) ) )() ==~ /here: (right|left): (right|left)/

// Modify bind to handle nulls -- Maybe monad

import org.codehaus.groovy.runtime.NullObject

bind = { mv, f ->
    mv().with { v ->
        v instanceof NullObject ? mreturn( null ) : f( v )
    }
}

assert mdirections( mdirections( mreturn( null ) ) )() == null

Tea table

def mtea = { mv, name ->
    bind( mv, { v ->
        mreturn( "$v and $name" )
    } )
}

assert mtea( mreturn( 'me' ), 'you' )() == 'me and you'

// Modify mreturn to handle sugar cubes -- State monad

mreturn = { v ->
    { s -> [ v, s ] }
}

bind = { mv, f ->
    { s ->
        mv( s ).with { v, sn ->
            f( v )( sn )
        }
    }
}

assert mtea( mreturn( 'me' ), 'you' )( 10 ) == [ 'me and you', 10 ]

def takesugar = { mv ->
    bind( mv, { v ->
        { s -> [ v, --s ] }
    } )
}

assert mtea( takesugar( mreturn( 'me' ) ), 'you' )( 10 ) == [ 'me and you', 9 ]
assert mtea( takesugar( takesugar( mreturn( 'me' ) ) ), 'you' )( 10 ) == [ 'me and you', 8 ]

The laws

mreturn = { mv -> { -> mv } }
bind = { mv, f -> f( mv() ) }
grow = { s -> mreturn( s + s[-1] ) }

// First monad law -- left unit
assert bind( mreturn( 'me' ), grow )() == grow( 'me' )()

// Second monad law -- right unit
assert bind( mreturn( 'me' ), mreturn )() == mreturn( 'me' )()

// Third law -- associative
assert bind( bind( mreturn( 'me' ), grow ), grow )() == bind( mreturn( 'me' ), { v -> bind( grow( v ), grow ) } )()