-- If you are familiar with Haskell or ML, the prelude may serve as a 
-- good introduction to formal.
-- Formal's syntax is quite liberal;  to illustrate, the prelude will 
-- maintain an intentionally inconsistent style throughout.

-- First, we need to create a namespace with the `module` keyword.

module prelude


    JS a = {} -> a

    inline object? x = do! `typeof x === "object"`
    inline array?    = do! `is_array`
    inline string? x = do! `typeof x === "string"`

    inline
    num? x = do! `typeof x == "number"`


    inline type? x   = do! `typeof x`

    inline
    not: Bool -> Bool 
    not x = do! `!x`
    not false
    

    object? {}
    array? []
    not (array? {})
    not (object? 0)



    -- Side effects can only happen in Javascript, so we use a monadic container to
    -- compose these bits.

    inline 
    (>>=): JS a -> (a -> JS b) -> JS b
    (>>=)  x       y            = y (run x)

    inline 
    (>>): JS a -> JS b -> JS b
    (>>)  x       y     = `run x; return (run y)`

    inline return:

             a -> JS a
      return x  = `x`

    
    do! x   <- `1 + 4`
        y   <- `2 + 3`
        ans <- `x + y`
        return (10 == ans)

    5  == do! return 5
    10 == do! `5 + 5`



    inline log: a -> JS {} 
              | x  = `console.log(x)`

    -- Testing to verify that escaping Javascript & utilizing escaped
    -- Javascript with `do` sugar and composition in general works as
    -- expected.

    var x = 0
        y = do z <- `x = 1`
               return z
    x == 0


    -- Numbers
    -- -------
    -- Some basic aliases to native javascript infix functions.  These are type
    -- annotated to constrain inferrence - otherwise, these functions would all be
    -- inferred as `a -> b -> c`.

    inline (&&): Bool -> Bool -> Bool | x y = do! `x && y`
    inline (||): Bool -> Bool -> Bool | x y = do! `x || y`
    inline (*):  Num -> Num -> Num    | x y = do! `x * y`
    inline (/):  Num -> Num -> Num    | x y = do! `x / y`
    inline (%):  Num -> Num -> Num    | x y = do! `x % y`
    inline (+):  Num -> Num -> Num    | x y = do! `x + y`
    inline (-):  Num -> Num -> Num    | x y = do! `x - y`
    inline (<=): Num -> Num -> Bool   | x y = do! `x <= y`
    inline (>=): Num -> Num -> Bool   | x y = do! `x >= y`
    inline (<):  Num -> Num -> Bool   | x y = do! `x < y`
    inline (>):  Num -> Num -> Bool   | x y = do! `x > y`

    -- Equality is overloaded to match records and arrays. By constraining the type of
    -- this operator, we need only dispatch on the type of the first element,
    -- constraining 

    inline x != y = not (x is y)

    inline x /= y = not (x == y)

    (==): a -> a -> Bool
        | x y when do! `x === y` = true
        | x y when object? x =
            do! `var result = true;
                 for (key in x) {
                    result = result && y.hasOwnProperty(key) && _eq_eq(x[key])(y[key]);
                 };

                 var z = Object.keys(x).length 
                             === Object.keys(y).length;

                 result && z`
                 
        | x y when array? x =
            do! `var result = true;
                 for (z in x) {
                     result = result && _eq_eq(x[z])(y[z]);
                 };

                 result && x.length == y.length`

        | x y = false

    -- And a few simple tests to verify the correctness of these
    -- implementations.  This is not meant to be exhaustive, only a smoke
    -- test against regressions.

    (3 * 4) + 5 * 4 == 64 / 2
    4 - 1 != 5 - 10
    (10 >= 5 + 5) != (4 + 5 <= 10 - 2)
    ({test: 1} == {test: 1}) == true
    ({test: 1} != {test: 1}) == false

    -- Fibonacci function

    fib 0 = 0 | 1 = 1 | n = fib(n - 1) + fib(n - 2)

    -- Speed
    -- -----

    -- Due to the nested recursion, `fib` is an excellent function for testing the
    -- runtime speed versus raw javascript.  `fast_fib` is a trivial javascript
    -- implementation of the same function, recursed itself to remove any potential
    -- overhead from formal's dispatch mechanism.

    module speedtest

        private inline get_time = `new Date().getTime()`

        time js =

            do start <- get_time
               js
               stop  <- get_time
               return (stop - start)

        private inline
        fast_fib =

            do! `var f = function(n) {
                     return 0 === n ? 0 : 1 === n ? 1 : f(n - 1) + f(n - 2)
                 }; f`
                
        fast_fib 7 == fib 7
        
        -- With this, we can set up a simple canary to let us know if the prelude is
        -- suddenly dramatically slower than it previously was; in this case, we fail a test
        -- if the formal version isn't at least 90% as fast as the native javascript
        -- version.

        floor: Num -> Num = do! `Math.floor`

        do! fast_time <- time yield fast_fib 30
            slow_time <- time yield fib 30
            return (floor (fast_time / slow_time * 100) >= 80)

    -- Function Combinators
    -- --------------------
    -- Simple left & right pipes, ala F#.  

    inline x <| y = x y
    inline x |> y = y x
    
    3 |> (λy = y + 1) |> λy = y + 1 == 5
    (λy x z = x + y + z + 1) 1 <| 3 <| 4 == 9
    
    -- Alternatively, there is a right associative version of `<|`, ala
    -- haskell.  All operators which end with a `:` are right associative.

    inline x <: y = x y
    
    (λx = x - 3) <: (λx = x - 3) <: 5 + 5 == 4
    
    -- Function composition

    inline x .: y = λz = x y(z)
    inline id x = x
    inline flip(f) x y = f(y, x)

    inline x ' y = y x

     
    ((λx = x + 1) .: (λx = x * 2) .: λx = x - 3) 4 == 3
    id [1, 2, 3] == [1, 2, 3]
    flip (λx y = x - y) 3 5 == 2



    -- Strings
    -- -------

    module string
        
        inline 
        lstrip: String -> String
        lstrip x = do! `x.replace(/^\s+/, '')` 
 
        inline rstrip: String -> String | x = do! `x.replace(/\s+$/, '')` 
        inline strip:  String -> String | = lstrip .: rstrip

        length: String -> Num | n = do! `n.length`

        inline 
        (+++): a -> b -> String
        x +++ y = do! `"" + x + y`

        strip "    test    " is "test"

        -- interpolated strings

        let x = "test"
        in "hello `x`" is "hello test"

    open string

    -- Tests
    -- -----
    -- By invoking javascript, we can listen for exceptions.
             
    err x = do! `try {
                     x();
                     return false;
                 } catch (e) {
                     return e;
                 }`

    -- Option
    -- ------

    module option
        
        Option a = {some: a} | {none}
        
        option b {none} = b
             | _ {some: x} = x
             
        option 3 {some: 2} == 2

    module html

        HTML = { element:   a
                 inner:     JS String
                 on_click:  JS {} -> JS {}
                 set:       b -> JS {}
                 add_class: String -> JS {}
                 add_style: String -> String -> JS {} }

        get:
              String -> JS HTML
            | x = do el <- `$(x).get(0)`

                     return { element    = el
                              inner      = `el.innerHTML`
                              on_click y = `el.onclick = y`
                              set y      = `el.innerHTML = y`

                              add_class y =
                                  `el.setAttribute("class", el.getAttribute("class") + " " + y)`

                              add_style y z = `el.style[y] = z` }

        inline ($=):

           String -> a -> JS {}
           x      $= y  =

             `if (typeof $ != "undefined") {
                  var xx = $(x).get(0);
                  if (typeof xx != "undefined") {
                      xx.innerHTML = y;
                  }
              }`

        inline ($|): 

             String   -> String -> String -> JS {}
             selector $| rule      value   = `$(selector).css(rule, value)`

        inline 
        ($.): String -> String -> JS {}
        ($.) x y = `$(x).addClass(y)`

        inline ($+): String -> String -> JS {}
            | x y = `$(x).append(y)`

        div: String -> JS String
            | x = yield "<div id='`x`'/>"

        move: HTML -> HTML -> JS a
            | x y = `$(y.element).append($(x.element).detach())`
                       
        on_load: JS {} -> JS {}
            | x = `window.addEventListener("load", x, false)`

        inline stringify: a -> String | x = do! `JSON.stringify(x)`

        inline (!!): Array a -> Num -> a | x y = do! `x[y]`

        with_page: JS<a> -> JS<a>
            | x = do old <- `$("body").clone()`
                     xx <- x
                     `$("body").replaceWith(old)`
                     return xx

        -- do! with_page do "body" $= "Test"
        --                  text <- get "body"
        --                  text <- text.inner
        --                  return (text == "Test")

        do! d <- div "test1"

            "body"   $+ d
            "#test1" $= "I am a test!"

            text <- get "#test1"
            text <- text.inner

            "#test1" $= ""

            return (text == "I am a test!")

        inline split: String -> String -> Array String | y x = do! `x.split(y)`


        -- This is the initializer for prelude's console test suite. 

        console_runner: JS {} =

            var is_error = 0

            var get_line x =  x |> split "__::__"
                                |> \x = x !! 0
                                |> split "_" 
                                |> \x = x !! 0
                                |> \x = do! `parseInt x`
                                |> \x = x + 1
                                |> stringify

            var report_failed spec results =

                    let items = spec.results_.items_
                        desc  = spec.description.split "__::__" !! 1
                        exp   = stringify (items !! 0).expected
                        act   = stringify (items !! 0).actual
                        line  = get_line spec.description
                    
                    do  if is_error == 0
                            then log "\r                        " 
                            else return {}

                        `is_error = 1`

                        log "Test failed at line `line`

                             `desc`
                             
                                 Expected `exp`
                                 Actual   `act`"

                        log ""

            var report spec = 

                    do! results <- `spec.results()`
                        passed  <- `results.passed()`

                        if   passed 
                        then return {}
                        else report_failed spec results

            var reporter = { reportSpecResults:   report 
                             reportRunnerResults: `phantom.exit(is_error)` }

            do env <- `jasmine.getEnv()`

               `env.addReporter(reporter)`
               `env.execute()`


        push : a -> Array a -> JS (Array a)
        push xs x = `xs.push(x)` 

        private console_reporter = {

            total    = 0
            failed   = 0

            messages = []

            reportSpecResults spec =

                do! results <- `spec.results()`
                    passed  <- `results.passed()`
                    `console_reporter.total++`

                    if not passed then do
                        `console_reporter.failed++`
                        push console_reporter.messages spec.description
                        return {}
                    else return {}

            reportRunnerResults =

                do if console_reporter.failed > 0
                       log console_reporter.messages
                   else 
                       return {}
                         
                   log "`console_reporter.total - console_reporter.failed`/`console_reporter.total` tests passed"
        }

        -- This is the initializer for prelude's HTML test suite. 

        table_of_contents =

            do "code"  $. "prettyprint"
               "code"  $. "lang-hs"

               ".test" $| "position" <| "relative"
               ".test" $| "left"     <| "50px"

               `prettyPrint()`

               trivial <- `new jasmine.TrivialReporter()`
               formal  <- `new jasmine.FormalReporter()`
               env     <- `jasmine.getEnv()`

               `env.addReporter trivial`
               `env.addReporter formal`
               `env.addReporter console_reporter`

               `env.execute()`

               reporter <- get ".jasmine_reporter"
               body     <- get "#test_suite"

               move reporter body


                       
    -- Lists
    -- -----
    -- A simple implementation of a library for manipulating linked lists.

    module list
    
        List a = { head: a, tail: List a } 
               | { nil }
                 
        -- This complex type can be hidden behind a constructor function which
        -- works more like a traditional cons.

        inline 
        x :: y = { head = x, tail = y }

        -- The compiler itself also supports the list sugar `[: 1, 2, 3 ]` (or
        -- `[: 1, 2, 3 :]`, if you prefer symmetry).  All of these lists are
        -- synonyms.

        var xs = [:

            [:1,2,3]

            [:1,2,3:]

            (1::2::3::{nil})

            { head = 1
              tail = { head = 2
                       tail = { head = 3
                                tail = {nil} }}}
        ]

        all? (λy = [:1,2,3] == y) xs 
                           

        -- Simple implementations of list accessors, which illustrate
        -- incomplete definition.

        empty? { nil } = true | _ = false

        head { head: x, tail: _ } = x
           | { nil } = error "Head called on empty list"
           
        tail { head: _, tail: x } = x 
           | { nil } = error "Tail called on empty list"

        last { head: x, tail: { nil } } = x
        last { head: _, tail: x } = last x
        last { nil } = error "Last called on empty list"

        take 0 x = { nil } | n x = head x :: take (n - 1) (tail x)
        drop 0 x = x | n x = drop (n - 1) (tail x)

        x .. y = 
            let f xx z when xx >= x = f (xx - 1) (xx :: z)
                f _ z = z 

            f y {nil}
           
        1 .. 5 == [:1,2,3,4,5]

        -- Project Euler problem 1, modified to protect the innocent:

        288045 == 1 .. 1111 |> filter (λx = x % 3 == 0 || x % 5 == 0) |> sum


        take_while f { nil } = { nil }
                 | f x when f (head x) = head x :: filter f (tail x)
                 | _ _ = { nil }

        drop_while f { nil } = { nil }
                 | f x when f (head x) = drop_while f (tail x)
                 | _ x = x

        not (empty? (1 :: {nil}))
        empty? [:]
   
        head [: 1, 2 ] is 1
        tail [: 1, 2 ] is [:2]
        last [: 1, 2 ] is 2

        err (lazy head {nil}) is "Head called on empty list"
        err (lazy tail {nil}) is "Tail called on empty list"
        err (lazy last {nil}) is "Last called on empty list"

        take(2, [: 1, 2, 3 ]) == [: 1, 2 ]
        drop(2, [: 1, 2, 3 ]) == [: 3 ]

        take_while (λx = x < 0) [:] == [:]
        take_while (λx = x > 0) [: 2, 1, 0 ] == [: 2, 1 ]

        drop_while (λx = x < 0) {nil} == {nil}
        drop_while (λx = x > 0) [: 2, 1, 0 ] == [: 0 ]

        -- Cardinality
        
        length 

             | {nil}              = 0
             | {head: _, tail: x} = 1 + length x
             
        length [: 1, 2, 3, 4 ] == 4

        -- Generators

        init 0 _ = {nil}
           | n x = x :: init (n - 1) x
           
        length (init 30 0) == 30
        tail (init 3 0)    == init 2 0

        -- List concatenation

        (++)

           | {nil} y                = y
           | {head: y, tail: ys} xs = y :: (ys ++ xs)

        {nil} ++ (1 :: 2 :: {nil}) == 1 :: 2 :: {nil}
        [: 1, 2 ] ++ [: 3, 4 ] == [: 1, 2, 3, 4 ]
                  
        -- Filter.

        filter: (a -> Bool) -> List a -> List a
              | f {nil} = {nil}
              | f x when f (head x) = head x :: filter f (tail x)
              | f x = filter f <| tail x
        
        [: 1, 2, 3, 4 ] 'filter (λx = x > 2) == [: 3, 4 ]

        -- Map
       
        map(f, {nil}) = {nil}
        map(f, x)     = f(head(x)) :: map(f, tail(x))
          
        [: 2, 3, 4 ] == [: 1, 2, 3 ] |> map λx = x + 1
            
        -- Reverse

        reverse y = 
            let r rest [:] = rest
                r rest { head: x, tail: xs } = 
                    r (x :: rest) xs

            in  r {nil} y

        reverse [: 1, 2, 3, 4 ] == [: 4, 3, 2, 1 ]

        var test_x = [: 1, 2, 3, 4 ]
        test_x == reverse <| reverse test_x

        take' x y =
            let t(0, _, acc) = acc
                t(n, x, acc) = t(n - 1, tail x, head x :: acc)

            in  reverse t(x, y, {nil})

        var x = [: 1, 2, 3, 4, 5, 6, 7, 8 ]
        take 5 x == take' 5 x

        -- Folds

        foldl f x xs =
            var g y {nil} = y
                | y { head: z, tail: zs } = g (f y z) zs
            g x xs

        foldl1 _ {nil} = error "Foldl1 called on empty list"
             | f x = foldl f (head x) (tail x)
     
        foldr f x =
            var g {nil} = x
                g { head: y, tail: ys } = f y (g ys)
            g

        foldr1 _ {nil} = error "Foldr1 called on empty list"
             | f x = foldr f (head x) (tail x)
        
        all? f = foldl1 (λx y = x && y) .: map f
        any? f = foldl1 (λx y = x || y) .: map f

        sum     = foldl1 λ(x, y) = x + y
        product = foldl1 λ(x, y) = x * y
        
        concat = foldl1 λx y = x ++ y
        concat_map f xs = concat (map f xs)
        
        maximum = foldl1 λ(x, y) when x > y = x
                         |(_, y) = y

        minimum = foldl1 λx y = if x > y then y else x

        foldl (λx y = x + y) 0 [: 1, 2, 3, 4 ] == 10
        foldr (λx y = x + y) 0 [: 1, 2, 3, 4 ] == 10
        all? id [:true,true]
        not (all? id [:true,false])
        any? id [:true,false]
        not (any? id [:false,false])
        sum [:1,2,3] == 6
        product [:1,2,4] == 8

        let x = [:1,2], y = [:3,4]
        concat [:x,y] == [:1,2,3,4]

        concat_map (λx = [:x,x+1]) [:1,2] == [:1,2,2,3]
             
        minimum [: 1, 2, 3 ] == 1
        maximum [: 1, 2, 3 ] == 3
        

    -- Sequences
    -- ---------
    -- Sequences are an abstract data type which resembles a list, except that elements
    -- Sequences may be infinite, as long as you never try to read every element.
    -- However, the current implementation is stack-consuming and thus limited by the
    -- underlying javascript runtime [TODO].  

    module seq

        open list
        open speedtest
        open html
    
        Seq a = { seq: JS { elem: a, next: Seq a}}
              | { end }

        inline seq x = {seq: x}
                   
        iterate f x = seq yield { elem: x, next: iterate f (f x) }

        from_list {nil} = {end}
                | { head: x, tail: xs } =
                    { seq: yield { elem: x, next: from_list xs }}
                    
        to_list { end }    = {nil}
              | { seq: x } = do! { elem: y, next: ys } <- x
                                 return (y :: to_list ys)

        take _ {end} = {end}
           | 0 _ = {end}
           | x { seq: y } = seq do { elem: z, next: zs } <- y
                                   return { elem: z, next: take (x - 1) zs }

        to_list (from_list [:1,2]) == [:1,2]
        iterate (λx = x + 1) 0 |> take 100 |> to_list |> length == 100

        zip_with:
        
              (a -> b -> c) -> Seq a -> Seq b -> Seq c
            | _ {end}    _____    = {end}
            | _ _____    {end}    = {end}
            | f {seq: a} {seq: b} = seq do

                { elem: xx, next: xs } <- a
                { elem: yy, next: ys } <- b

                return { elem: f xx yy, next: zip_with f xs ys }
                                        
        inline x ::: y = seq yield { elem: x, next: do! y }
        
        tail:
              Seq a   -> Seq a
            | {end}    = error "tail called on empty seq"
            | {seq: t} = do! t >>= λx = return x.next
 
        to_lazy
              | {end} = {end}
              | {seq: y} = seq lazy do!
                    {elem: x, next: xs} <- y
                    return {elem: x, next: to_lazy xs}
 
        -- Infinite sequence example
 
        fibs = to_lazy <: 1 ::: return <: 1 ::: yield zip_with (λx y = x + y) fibs <: tail fibs
    
        -- Since the `lazy` keyword memoizes it's argument, this fibonacci implementation
        -- is ridiculously faster than the recursive version.  For example, the runtime
        -- speed of this fib implementation compared to the native recursive one is <span
        -- id="speedtest">__________</span>%.

        do! fast_time <- time yield fast_fib 30
            slow_time <- time yield fibs |> take 30 |> to_list |> last
            let ratio = floor (fast_time / slow_time * 100)
            "#speedtest" $= ratio
            return (ratio >= 2)

        fibs |> take 5 |> to_list == [:1,1,2,3,5]

        fast_fib 15 == fibs |> take 15
                            |> to_list
                            |> last


    -- FormalZ
    -- -------
    -- Demonstration of some classic FP data structures.  This form of polymorphism can
    -- be simulated in Formal the same way they are implemented in Haskell - as a function
    -- dictionary, the only difference being that you must explicitly bind the dictionary
    -- instance to a symbol (as opposed to it being referenced by the type variable's
    -- instantiation).

    module "Formal Z"

        open list

        Functor f =

            { map: (a -> b) -> f a -> f b }

        Monad m =

            { (>>=): m a -> (a -> m b) -> m b
              ret: a -> m a }

        map z x f = z.map f x

        bind { ret: f, _ } x = f x

        list_functor =

            { map _ {nil} = {nil} 
                | f { head: x, tail: xs } =
                      { head: f x
                        tail: list_functor.map f xs }}

        list_monad =

            { (>>=) x g = concat_map g x
              return x = [:x] }

        js_monad =

            { (>>=) x f = x >>= f
              return x = return x }

        let (>>>=) x g = concat_map g x
            z = 1 .. 3 >>>= λx = [:x, x + 1, x + 2]

        z == [:1,2,3,2,3,4,3,4,5]