lens.lua

--[=[

Relevant functions for creating lenses
Note that not all functions are always implemented

For Lens s t a b:

over : (a -> b) -> s -> t
    Map a function over the target of the lens
    Ex. over(each..each, function(x) return x+1 end, {{1,2},{3,4}})
    --> {{2,3},{4,5}}
view : s -> a
    View the target of the lens
    Ex. view(name..firstName, {name = {firstName = 'Bob', lastName = 'Smith'}})
    --> 'Bob'
toListOf : s -> [a]
    View all targets, collecting them into a list
    Ex. toListOf(each..name, {{name = 'A'}, {name = 'B'}, {name = 'C'}})
    --> {'A', 'B', 'C'}
from : Lens a b s t
    Flip a lens around
    Ex. view(numToString, 2) --> '2'
        view(from(numToString), '3') --> 3
construct : b -> t
    Construct a value from the lens
    Ex. view(head..head, {}) --> nil
        view(head..head, {{1, 2}, {3, 4}}) --> 1
        construct(head..head, 3) --> {{3}}
    
]=]

local Lens = {}
Lens.mt = {}

Lens.methods = {
    view      = 'view',
    over      = 'over',
    toListOf  = 'toListOf',
    construct = 'construct',
    from      = 'from'
}

function Lens.new(t)
    assert(type(t) == 'table')
    for k, v in pairs(t) do
        assert(Lens.methods[k])
        assert(type(v) == 'function')
    end
    return setmetatable(t, Lens.mt)
end

function Lens.mt:__concat(l)
    local new = {}
    if self.view and l.view then
        new.view = function(s)
            local s1 = l.view(s)
            if s1 == nil then
                return nil
            else
                return self.view(s1)
            end
        end
    end
    if self.over and l.over then
        new.over = function(f, s)
            return self.over(function(s1) return l.over(f, s1) end, s)
        end
    end
    if self.toListOf and l.toListOf then
        new.toListOf = function(s)
            local res = {}
            for _, v in ipairs(self.toListOf(s)) do
                for _, v1 in ipairs(l.toListOf(v)) do
                    res[#res+1] = v1
                end
            end
            return res
        end
    end
    if self.construct and l.construct then
        new.construct = function(args)
            return self.construct(l.construct(args))
        end
    end
    if self.from and l.from then
        new.from = function()
            return l.from .. self.from
        end
    end
    return new
end

-- Smart constructors
-- lens : (s -> a) -> (s -> b -> t) -> Lens s t a b
local function lens(get, set)
    return Lens.new{
        view = get,
        toListOf = function(s) return {get(s)} end,
        over = function(f, s)
            return set(s, f(get(s)))
        end
    }
end

-- iso : (s -> a) -> (b -> t) -> Iso s t a b
local function iso(to, from)
    return Lens.new{
        view = to,
        toListOf = function(s) return {to(s)} end,
        from = function() return iso(from, to) end,
        over = function(f, s)
            return from(f(to(s)))
        end,
        construct = from
    }
end

-- folding : (s -> [a]) -> Fold s a
local function folding(f)
    return Lens.new{
        toListOf = f
    }
end

-- to : (s -> a) -> Getter s a
local function to(f)
    return Lens.new{
        toListOf = function(s) return {f(s)} end,
        view = f
    }
end

-- sets : ((a -> b) -> s -> t) -> Setter s t a b
local function sets(f)
    return Lens.new{
        over = f
    }
end

-- prism : (b -> t) -> (s -> a?) -> Prism s t a b
-- 'a?' means 'a or nil'
local function prism(construct, maybe_get)
    return Lens.new{
        construct = construct,
        toListOf = function(s)
            return {maybe_get(s)} -- {nil} == {} in Lua
        end,
        over = function(f, s)
            local s1 = maybe_get(s)
            if s1 == nil then
                return s
            else
                return construct(f(s1))
            end
        end
    }
end

-- unto : (b -> t) -> Review t b
local function unto(f)
    return Lens.new{
        construct = f
    }
end

-- Helper functions

local function view(l, s)
    assert(l and l.view)
    return l.view(s)
end

local function over(l, f, s)
    assert(l and l.over)
    return l.over(f, s)
end

local function set(l, val, s)
    assert(l and l.over)
    return l.over(function(_) return val end, s)
end

local function perform(l, f, s)
    assert(l and l.toListOf)
    local t = {}
    for _, v in ipairs(l.toListOf(s)) do
        t[#t+1] = f(v)
    end
    return t
end

local function construct(l, args)
    assert(l and l.construct)
    return l.construct(args)
end

local function toListOf(l, s)
    assert(l and l.toListOf)
    return l.toListOf(s)
end

local function from(l)
    assert(l and l.from)
    return l.from()
end

--
-- Basic Lenses
--

-- ipairsL - iterate over all list elements
local ipairsL = Lens.new{
    toListOf = function(l)
        return l
    end,
    over = function(f, l)
        local l1 = {}
        for k, v in ipairs(l) do
            l1[k] = f(v)
        end
        return l1
    end
}

-- pairsL - iterate over all table elements
local pairsL = Lens.new{
    toListOf = function(l)
        local l1 = {}
        for _, v in pairs(l) do
            l1[#l1+1] = v
        end
        return l1
    end,
    over = function(f, l)
        local l1 = {}
        for _, v in pairs(l) do
            l1[#l1+1] = f(v)
        end
        return l1
    end
}

-- only : a -> Prism' a ()
-- compares for equality
local function only(val)
    local function equal(a, b)
        if type(a) == type(b) then
            if type(a) == 'table' then
                for k, v in pairs(a) do
                    if b[k] ~= v then return false end
                end
                return true
            else
                return a == b
            end
        else
            return false
        end
    end
    return Lens.new{
        over = function(f, s)
            if equal(val, s) then
                return f(s)
            else
                return s
            end
        end,
        toListOf = function(s)
            if equal(val, s) then
                return {{}}
            else
                return {}
            end
        end,
        construct = function(_) return val end
    }
end

-- filtered : (a -> Bool) -> Fold a a
local function filtered(p)
    return Lens.new{
        toListOf = function(s)
            if p(s) then
                return {s}
            else
                return {}
            end
        end
    }
end

-- takingWhile : (a -> Bool) -> Fold s a -> Fold s a
local function takingWhile(p, l)
    return Lens.new{
        toListOf = function(s)
            local l1 = l.toListOf(s)
            local l2 = {}
            for _, v in ipairs(l1) do
                if p(v) then
                    l2[#l2+1] = v
                else
                    return l2
                end
            end
            return l2
        end
    }
end

-- worded : Fold String String
-- fold over the words of a string
local worded = Lens.new{
    toListOf = function(s)
        local words = {}
        for w in string.gmatch(s, '%a+') do
            words[#words+1] = w
        end
        return words
    end
}

-- lined : Fold String String
local lined = Lens.new{
    toListOf = function(s)
        local lines = {}
        for l in string.gmatch(s, '[^\n]*') do
            lines[#lines+1] = l
        end
        return lines
    end
}

-- allOf : Fold s a -> (a -> Bool) -> s -> Bool
local function allOf(l, p, s)
    local res = toListOf(l, s)
    for _, v in ipairs(res) do
        if not p(v) then return false end
    end
    return true
end

-- lengthOf : Fold s a -> s -> Int
local function lengthOf(l, s)
    return #(toListOf(l, s))
end

-- firstOf : Fold s a -> s -> a?
local function firstOf(l, s)
    return toListOf(l, s)[1]
end

-- nullOf : Fold s a -> s -> Bool
-- returns true if no targets
local function nullOf(l, s)
    return #(toListOf(l, s)) == 0
end

-- notNullOf : Fold s a -> s -> Bool
local function notNullOf(l, s)
    return #(toListOf(l, s)) ~= 0
end

-- key : String -> Prism' {k:t} t?
local function key(k)
    return prism(function(v) return {[k] = v} end, function(t) return t[k] end)
end

do
    return {
        -- Lens type
        Lens = Lens,
        -- constructing lenses
        lens = lens,
        iso = iso,
        prism = prism,
        unto = unto,
        sets = sets,
        folding = folding,
        to = to,
        -- Using lenses
        view = view,
        over = over,
        set = set,
        toListOf = toListOf,
        construct = construct,
        from = from,
        perform = perform,
        -- Basic lenses
        key = key,
        ipairs = ipairsL,
        pairs = pairsL,
        only = only,
        filtered = filtered,
        takingWhile = takingWhile,
        worded = worded,
        lined = lined,
        allOf = allOf,
        lengthOf = lengthOf,
        firstOf = firstOf,
        nullOf = nullOf,
        notNullOf = notNullOf,
    }
end

test.lua

local L = require 'lens'
local lfs = require 'lfs'

-- Predicate that determines if a filepath is hidden
local function isnt_hidden(filepath)
    return not filepath:sub(1,1) == '.'
end
-- Function returning a lens that accesses the given mode of the given filepath
local function file_attribute(attr)
    return L.to(function(filepath) return lfs.attributes(filepath, attr) end)
end
-- A lens that returns all child directories of a filepath
local directories = L.folding(
    function (filepath)
        local t = {}
        for d in lfs.dir(filepath) do
            t[#t+1] = d
        end
        return t
    end)
-- Reversible lens between a list of characters and a string
local str2list = L.iso(
    function(str)
        local t = {}
        for c in str:gmatch('.') do
            t[#t+1] = c
        end
        return t
    end,
    function(t)
        return table.concat(t)
    end)

--

local s = arg[1] or '.'
print(('The file "%s" is a "%s"'):format(s, L.firstOf(file_attribute('mode'), s)))
print('Children:')
local dirs = L.toListOf(
    directories..L.filtered(isnt_hidden),
    s)
for _, v in pairs(dirs) do print('\t' .. v) end

local without_a = L.toListOf(
    str2list..L.ipairs..L.filtered(function(c) return c ~= 'a' end),
    'Howdy partner!')
assert(table.concat(without_a) == 'Howdy prtner!')