Modules.fold

--
-- Interfaces
--


{- # Type Module

   To group together a type and a collection of functions that operate on that
   type a _Type Module_ can be used. Type modules create both: a type and a
   module for that type, with the same name. So the type declaration must have
   exactly the same name as the module.

   > Note: OCaml has no native support for type module but the equivalent model
   > is widely used with the conventional type `Module.t`.

   > Warning: The usage of the module's name may be replaced by `Self`.

   Not only the declaration of the type uses the same name, but also all the
   function and value signatures use it.
 -}

module Person
  type Self = { name :: String, age :: Int }

  val name :: Self -> String
end

{-
  This pattern makes it easier to extend types, since no changes have to be
  performed to the existing declarations. Compared to OCaml, the beginners
  will not be asking what the type `t` means, the proposed model is natural:
  you had a type and now it moved to its own module.

  > TODO: Review how the interface inclusion will work:
  >   include Monad with type t = t
  > will become:
  >   include Monad for type List
 -}



module List
  type List a = [] | a & List a

  let List (l: List a) = l

  let List (v: Vec a) = Vec.to_list v

end

--
-- # Modules
--
-- * 1.0 Definition
-- * 2.0 Loading and Opening Modules
-- * 3.0 Functors

--
-- ## 2.0 Loading and Opening Modules
--

--
-- Load a module
--
-> load OS

-- Only the module can be used
-> user = OS.getenv "USER"
user :: String = "dmr"


--
-- Load a module using an alias
--
-> load OS as POSIX

-- Only the alias can be used
-> user = POSIX.getenv "USER"
user :: String = "dmr"

-- Using module name directly will not work
-> user = OS.getenv "USER"
 * Error: Unbound module OS


--
-- Load multiple modules
--
-> load OS, Sys

-- Both modules can be used.
-> user = OS.getenv "USER"
user :: String = "dmr"
-> Sys.time ()
:: Float = 0.276656


--
-- Load a module and some symbols.
--
-> load OS with: [getenv, getuid as uid]

-- The `getenv` and `getuid` symbols can be used directly.
-> user, uid = getenv "USER", uid ()
user :: String = "dmr"
 uid :: Int = 501
-- The `OS` was also loaded and can be used.
-> OS.getguid ()
:: Int = 20

--
-- Open all module symbols
--
-- The usage of `open` without selection is discouraged since conflicting
-- symbols may be introduced in the scope. In which case, for a conflicting
-- name, the last imported definition will be used.
--
-> open OS

-- All module symbols can be used directly.
-> getuid ()
:: Int = 501
-> getgid ()
:: Int = 20
-- Opened modules are not loaded.
-> OS.getuid ()
 * Error Unbound module OS


--
-- Open only some module symbols
--
-> open OS only: [getcwd as cwd]

-- Only the symbols `cwd` was opened from the module.
-> cwd ()
:: String = "/home/dmr"

-- Open all module symbols with exceptions
open OS hide: [mkdir, mkfifo]



--
-- Interfaces
--

sig Animal T
    init :: String -> T
    name :: T -> String
    talk :: T -> String
end

data Dog (name : String)

instance Animal Dog {
    make :name = Dog name
    name dog = dog.name
    talk dog = "woof!"
}

laika : Dog = make name: "Laika Kosmonavt"
name laika == "Laika Kosmonavt"
talk laika == "woof!"

-- Module User

sig Show T
    show :: T -> String
end

type User = (name: String, birthday: Date, profession: String)

ext Show User
  let show (self::User) -> String = u.name
end


protocol Show T {
    show : T -> String
}


instance Show {Eq T} :: (List a)
    show
end

instance Show {Eq T} :: (Int -> String -> (Person, a))
    show
end

show (u::User) = u.name

show (M::Show) (x::M a) = u.name


map `round [1, 2, 3]

alice :: User =
  { name: "Alice",
    birthday: 14/08/2014,
    profession: `cat }

show alice


type ordering = LT | EQ | GT

protocol Comparable a
    function compare :: a -> a -> ordering
end

instance Comparable int
    function compare a b
           | a == b -> EQ
           | a >  b -> GT
           | a <  b -> LT
    end
end


----

type ordering = LT | EQ | GT

protocol Comparable a:
    compare :: a -> a -> ordering

instance Comparable Int:
    compare x y =
        if | x == y -> EQ
           | x >  y -> GT
           | x <  y -> LT

instance Comparable User =
    compare x y = compare x.name y.name


module User =
    type user = ...
    compare x y =



-- // --



module JSONCodec n do
    Log.info "Will calculate factorial of {n}"
    (n == 0) ? 1 : n * factorial (n - 1)
end

interface Codec a =
    encode :: a -> Result Data
    decode :: Data -> Result a
end

module Codec Json =
    encode = String x => "\"{x}\""
           | Object x => surround x with ('{', '}')
           | List xs  => surround (join (map encode xs) with: ',')
                             with: '"'
end

module JSONCodec n =
    Log.info "Will calculate factorial of {n}"
    (n == 0) ? 1 : n * factorial (n - 1)
end

module JSONCodec n:
    Log.info "Will calculate factorial of {n}"
    (n == 0) ? 1 : n * factorial (n - 1)
end

JSONCodec n = module
    Log.info "Will calculate factorial of {n}"
    (n == 0) ? 1 : n * factorial (n - 1)
end

module JSONCodec n = {
    Log.info "Will calculate factorial of {n}"
    (n == 0) ? 1 : n * factorial (n - 1)
}

JSONCodec n = module {
    Log.info "Will calculate factorial of {n}"
    (n == 0) ? 1 : n * factorial (n - 1)
}



-- * --








module Option =
  type Self a = Some a | None

  self ? default =
    case self of:
      Some a -> a
      None   -> default


instance Functor Option =
  map f self =
    case self of:
      Some a -> Some (f a)
      None   -> None


instance Monad Option =
  pure = Some

  bind f self =
    case self of:
      Some a -> f a
      None   -> None














module Option
  type Self a = Some a | None

  self ? default =
    case self
      Some a -> a
      None   -> default
    end
end


instance Functor Option
  map f self =
    case self
      Some a -> Some (f a)
      None   -> None
    end
end


instance Monad Option
  pure = Some

  bind f self =
    case self
      Some a -> f a
      None   -> None
    end
end
















module Option {
  type Self a = Some a | None

  self ? default =
    case self {
      Some a -> a
      None   -> default
    }
}


instance Functor Option {
  map f self =
    case self {
      Some a -> Some (f a)
      None   -> None
    }
}


instance Monad Option {
  pure = Some

  bind f self =
    case self {
      Some a -> f a
      None   -> None
    }
}




-- * --

def data =
  HTTP.get "http://data.io/data.json"
    |> JSON.parse


def data :: Model
  HTTP.get "http://data.io/data.json"
    |> JSON.parse model
end


-- Expression notation
def hello name =
  print "Hello, $name!"


-- Block notation
def hello name
  print "Hello, $name!"
end


-- Expression notation
def hello name :: String -> () =
  print "Hello, $name!"


-- Expression notation
def hello (name :: String) -> () =
  print "Hello, $name!"


-- Block notation
def hello name :: String -> ()
  print "Hello, $name!"
end



-- Expression notation
mod IntSet =
  Set.Make Int


-- Block notation
mod IntSet
  include (Set.Make Int)
end


-- * --



{- Provenance tracking. -}

interface Irmin_task
  include Tc.S0

  val create :: date: Int64 -> owner: String -> uid: Int64? -> String -> Self
  val date :: Self -> Int64
  val uid :: Self -> Int64
  val owner :: Self -> String
  val messages :: Self -> List String
  val add :: Self -> String -> Unit
  val empty :: Self

  type f a = a -> self

  val none :: f ()
end


-- • --


-- replicate :: forall f a. Unfoldable f => Int -> a -> f a
-- replicate n v = unfoldr step n
--   where
--     step :: Int -> Maybe (Tuple a Int)
--     step i =
--       if i <= 0 then Nothing
--       else Just (Tuple v (i - 1))

def replicate n x = unfold step n
  where step i =
    if i <= 0 then None
    else Some (x, i - 1)

-- • --

-- Module Implemntations

-- Module definition
module M = { ... }
-- module M = struct ... end

-- Module definition with type
module M = { ... }
-- module M = struct ... end

interface M = { ... }
-- module type M = sig ... end

module M = Foo { ... }
-- module M = Foo (struct end)

module M = Foo int { ... }
-- module M = Foo.T0 (struct type nonrec t = int ... end)

include Foo { ... }
-- include Foo(struct ... end)

include Foo int { ... }
-- include Foo.T0(struct type nonrec t = int ... end)

include Foo int
-- include Foo.T0 with type t := int


-- Module Interfaces

module M :: I
-- module M : I

module M :: { ... }
-- module M : sig ... end

module M :: { ... }
-- module type M : sig ... end



-- • --
M : sig
M = mod { }

m : val int
f : fun int -> int