{- |
Module      :  Language.Javascript.JMacro.Prelude
Copyright   :  (c) Gershom Bazerman, Jeff Polakow 2010
License     :  BSD 3 Clause
Maintainer  :  gershomb@gmail.com
Stability   :  experimental
-}

{-# LANGUAGE QuasiQuotes #-}

module Language.Javascript.JMacro.Prelude where
import Language.Javascript.JMacro.Base
import Language.Javascript.JMacro.QQ

-- | This provides a set of basic functional programming primitives, a few utility functions
-- and, more importantly, a decent sample of idiomatic jmacro code. View the source for details.
jmPrelude :: JStat
jmPrelude = [$jmacro|

    fun withHourglass f {
          document.body.style.cursor="wait";
          setTimeout(\ {
             try {f();} catch(e) {console.log(e);}
             document.body.style.cursor="default";},
             400);
        };

    fun confirmIt n f {
              var r = confirm("Are you sure you want to " + n + "?");
              if(r) {
                f();
              }
              return false;
            };


    fun memo f {
            var tbl = {};
            return \x {
              var v0 = tbl[x];
              if( v0 == null )
                  { var v1 = f x;
                    tbl[x] = v1;
                    return v1
                  }
                  else { return v0 }
            }
        };

    fun mySplit str xs -> map $.trim (xs.split str);

    fun unquote open close x {
            var special = ["[","]","(",")"];
            fun escape c -> (elem c special ? "\\" : "") + c;
            var rgx = new RegExp("^"+escape open+"(.*)"+escape close+"$"),
                res = x.match(rgx);
            if( res != null ) {return res[1]} else {return x}
        };


    fun head xs -> xs[0];
    fun tail xs -> xs.slice(1);
    fun init xs {xs.pop(); return xs;};
    fun last xs -> xs[xs.length - 1];
    fun cons x xs {
        xs.unshift(x);
        return xs;
    };

    fun id x -> x;
    fun konst x -> \_ -> x;

    fun isEmpty x -> x.length == 0;

    fun notNull x -> x != null;
    fun nullDef def x -> x == null ? def : x;
    fun bindNl x f -> x == null ? null : f x;
    fun tryNull x notNull isNull -> x != null ? notNull x : isNull();

    // -- objFoldl is really just objFold (maps don't have a left and right)

    // --objFoldlEnumLbl :: (label -> b -> a -> (b,Bool)) -> b -> [a] -> b
    // --Provides shortcut escape.
    fun objFoldlEnumLbl f v xs {
        var acc = v;
        for( var i in xs ) {
          if (xs[i] != null) {
            var res = f i acc xs[i];
            acc = res[0];
            if( !res[1] ) { break; }
          };
        };
        return acc;
    };

    // --objFoldlEnum :: (b -> a -> (b,Bool)) -> b -> [a] -> b
    fun objFoldlEnum f v xs -> objFoldlEnumLbl (\_ acc x -> f acc x) v xs;

    // --As above, no shortcut return
    fun objFoldlLbl f v xs {
        var acc = v;
        for( var i in xs) {if (xs[i] != null) {acc = f i acc xs[i]};};
        return acc;
    };
    fun objFoldl f v xs -> objFoldlLbl (\_ acc x -> f acc x) v xs;

    fun mapObjVals f xs -> objFoldlLbl (\lbl acc x {acc[lbl] = f x; return acc}) {} xs

    fun objLength xs -> objFoldl (\n _ -> n + 1) 0 xs;
    fun objIter f xs -> objFoldl (\_ x {f x; return null}) null xs;
    fun objIterLbl f xs -> objFoldlLbl (\l _ v {f l v; return null}) null xs;

    fun objUnion xs ys {
        var res = {};
        for (var i in xs) {res[i] = xs[i]};
        for (var i in ys) {res[i] = ys[i]};
        return res;
    };

    // -- as above, but over arrays.
    fun foldlEnumIdx f v xs {
        var acc = v;
        for( var i = 0; i < xs.length; i = i + 1) {
            var res = f i acc xs[i];
            acc = res[0];
            if( !res[1] ) { break; }
        };
        return acc;
    };

    fun foldlEnum f v xs -> foldlEnumIdx (\_ acc x -> f acc x) v xs;

    fun foldl f v xs {  // -- foldlEnum (\acc x -> [f acc x, true]) v xs;
        var acc = v;
        for( var i = 0; i < xs.length; i++) {acc = f acc xs[i];};
        return acc;
    };

    fun foldl2 f v xs ys {
        var acc = v;
        for( var i = 0; i < xs.length && i < ys.length; i++) {acc = f acc xs[i] ys[i];};
        return acc;
    };

    fun foldr f v xs {
        var res = v;
        for( var i = xs.length - 1; i >= 0; i = i - 1) {res = f xs[i] res;};
        return res;
    };

    // -- IE doesn't treat strings as arrays
    fun strFoldr f v xs {
             var res = v;
             for (var i = xs.length - 1; i >= 0; i = i - 1) {res = f xs.charAt(i) res};
             return res;
    };

    fun max x y -> x > y ? x : y;
    fun min x y -> x < y ? x : y;
    fun maximumOrNull xs -> (xs.length == 0) ? null : foldl max (head xs) (tail xs);
    fun minimumOrNull xs -> (xs.length == 0) ? null : foldl min (head xs) (tail xs);
    fun sum x -> foldl (\a b -> a + b) 0 x;

    // -- ['a','b','c'] --> [['a',0], ['b',1], ['c',2]]
    fun addIndex xs {
            var res = [];
            for( var i = 0; i < xs.length; i++) { res.push([xs[i],i]) };
            return res;
    };


    // -- cmp x y is true when x > y
    fun minimumBy cmp xs -> foldl (\x y -> cmp x y ? x : y) (xs[0]) xs.slice(1);


    fun zipWith f xs ys {
            var res = [],
            l = min xs.length ys.length;
            for(var i = 0; i < l; i++) {
                res.push(f xs[i] ys[i]);
            }
            return res;
    };

    fun zip xs ys -> zipWith (\x y -> [x, y]) xs ys;

    fun zip3 xs ys zs {
            var res = [],
                l = min (min xs.length ys.length) zs.length;
            for(var i = 0; i < l; i++) {
                res.push([xs[i], ys[i], zs[i]]);
            }
            return res;
    };

    fun getTblHash tbl {
            var cols = $("th", $(tbl)).map(\_ x -> $(x).text());
            return map (\r -> foldl2 (\acc c v {acc[c] = $(v).text(); return acc}) {} cols $("td",$(r))) $("tbody tr", $(tbl))
        };

    // -- equality test which ignores case for strings
    fun eq x y {
            var x1 = typeof(x) == "string" ? x.toLowerCase() : x,
                y1 = typeof(y) == "string" ? y.toLowerCase() : y;
            return x1 == y1;
        };

    // -- structural equality
    fun equals x y {
       if(x===y) {return true;}
       if(typeof x != typeof y) {return false;}
       if($.isArray x && $.isArray y) {
          for(var n in x) {
             if (!(equals x[n] y[n])) {return false;}
          }
          return true;
       }
       return x == y;
    }

    fun map f xs -> foldl (\acc x {acc.push(f x); return acc}) [] xs;
    fun filter p xs -> foldl (\acc x {if (p x) {acc.push(x)}; return acc}) [] xs
    fun mapFilter p f xs -> foldl (\acc x {if (p x) {acc.push(f x)}; return acc}) [] xs
    fun concat xs -> foldl (\acc x -> acc.concat(x) ) [] xs

    fun toList xs -> map id xs;  // -- this can turn a jQuery object into a real list

    fun all p xs -> foldlEnum (\_ x -> [p x, p x]) true xs;

    fun findWithIdx p xs -> foldlEnumIdx (\i failure x -> p i x ? [x, false] : [failure, true]) null xs;
    fun findIdx p xs -> foldlEnumIdx (\i failure x -> p x ? [i, false] : [failure, true]) null xs;

    fun find p xs -> findWithIdx (\_ x -> p x) xs;

    fun elem x xs -> tryNull (find (\y -> x == y) xs) (konst true) (konst false);

    fun isPrefixOf x xs -> xs.search(new RegExp("^"+x)) != -1;

    // -- sortOn :: Ord b => (a -> b) -> [a] -> [a]
    fun sortOn f arr {
         fun cmpFun x y {
               var xv = f x,
                   yv = f y;
               if (xv == yv) {return 0};
               if (xv == null) {return 1};
               if (yv == null) {return -1};
               return xv > yv ? 1 : -1
         };
         arr.sort(cmpFun);
         return arr;
    }

    fun hashOn f xs {
      var hash = {};
      fun pushAttr x {
         var atr = f x;
         if( atr != null ) {
           if( hash[atr] == null ) { hash[atr] = [] };
           hash[atr].push(x)
         };
      };
      map pushAttr xs;
      return hash;
    }

    fun groupOn f xs {
       var hash = hashOn f xs;
       return objFoldl (\acc x {acc.push x; return acc;}) [] hash;
    }

    fun chunkBy x ys -> x >= ys.length ? [ys]
                                       : cons (ys.slice(0,x)) (chunkBy x (ys.slice(x)));

    fun transpose xxs {
      if (xxs.length == 0) {return []};
      if (xxs[0].length == 0) {return transpose (tail xxs);};
      var x = xxs[0][0],
          xs = xxs[0].slice(1),
          xss = xxs.slice(1);
      return cons (cons x (map head xss)) (transpose (cons xs (map tail xss))) // -- (x : map head xss) : transpose (xs : map tail xss)
    }


    // -- idxs is an array of (index, sort ascending?) pairs
    fun multiIdxSortGen idxs cmpFun modFun xs {
        var f = \x y -> \i acc idxsi {
                var cmp = cmpFun (modFun x)[i] (modFun y)[i];
                return (cmp != 0) ? [idxsi[1] ? cmp : cmp * (-1), false] : [acc, true]
            };

        xs.sort( \x y -> foldlEnumIdx (f x y) 0 idxs );
    };

    // --A few statistical funcutions.

    // -- ordinary least squares
    fun ols xs ys {
        if (xs.length != ys.length) {return null};
        var n = xs.length,
            sx = sum xs,
            sx2 = sum (map (\x -> x*x) xs),
            sy = sum ys,
            sxy = sum (zipWith (\x y -> x * y) xs ys),
            bot = n * sx2 - sx * sx,
            m = (n * sxy - sy*sx) / bot,
            b = (sy * sx2 - sx * sxy) / bot;
        return [m,b];
    };

    // -- Linear regression
    fun doRegress xs {
              var xvs = map (\x -> x[0]) xs,
                  yvs = map (\x -> x[1]) xs,
                  regressres = ols xvs yvs,
                  m = regressres[0],
                  b = regressres[1],
                  yvs1 = map (\x -> m*x+b) xvs,
                  ymean = mean yvs,
                  sstot = sum (map (\y -> Math.pow (y - ymean) 2) yvs),
                  sserr = sum (zipWith (\y f -> Math.pow (y - f) 2) yvs yvs1),
                  xsNew = zipWith (\x y -> [x,y,x,y.toPrecision(2),""]) xvs yvs1;
              return [xsNew, (1 - (sserr/sstot)).toPrecision(4)];
    };


    fun mean xs {
       var res = xs[0];
       for (var i = 1;  i < xs.length; i++) {
           var x = xs[i];
           var delta = x - res;
           var sweep = i + 1.0;
           res = res + (delta / sweep);
           // -- sqsum += delta * delta * (i / sweep);
       }
       return res;
    };

    fun stdev xs {  // -- Knuth's standard deviation algorithm, returns [stdDev, mean, size]
        var n = 0,
            mean = 0,
            s = 0;
        for (var i = 0; i < xs.length; i++) {
            n = n + 1;
            var delta = xs[i] - mean;
            mean = mean + delta/n;
            s = s + delta*(xs[i] - mean);  // -- this expression uses the new value of mean
        };
        return [Math.sqrt (s/(n - 1)), mean, n];
    };

|]