Removed `($>)` and `(<$)`.

Removed `($>)` and `(<$)`.

module Prelude
  ( flip
  , const
  , asTypeOf
  , Semigroupoid, (<<<), (>>>)
  , Category, id
  , ($), (#)
  , (:), cons
  , Show, show
  , Functor, (<$>), (<#>), void
  , Apply, (<*>)
  , Applicative, pure, liftA1
  , Bind, (>>=)
  , Monad, return, liftM1, ap
  , Num, (+), (-), (*), (/), (%)
  , negate
  , Eq, (==), (/=), refEq, refIneq
  , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
  , Bits, (&), (|), (^), shl, shr, zshr, complement
  , BoolLike, (&&), (||)
  , not
  , Semigroup, (<>), (++)
  , Unit(..), unit
  ) where

  flip :: forall a b c. (a -> b -> c) -> b -> a -> c
  flip f b a = f a b

  const :: forall a b. a -> b -> a
  const a _ = a

  asTypeOf :: forall a. a -> a -> a
  asTypeOf x _ = x

  infixr 9 >>>
  infixr 9 <<<

  class Semigroupoid a where
    (<<<) :: forall b c d. a c d -> a b c -> a b d

  instance semigroupoidArr :: Semigroupoid (->) where
    (<<<) f g x = f (g x)

  (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
  (>>>) f g = g <<< f

  class (Semigroupoid a) <= Category a where
    id :: forall t. a t t

  instance categoryArr :: Category (->) where
    id x = x

  infixr 0 $
  infixl 0 #

  ($) :: forall a b. (a -> b) -> a -> b
  ($) f x = f x

  (#) :: forall a b. a -> (a -> b) -> b
  (#) x f = f x

  infixr 6 :

  (:) :: forall a. a -> [a] -> [a]
  (:) = cons

  foreign import cons
    "function cons(e) {\
    \  return function(l) {\
    \    return [e].concat(l);\
    \  };\
    \}" :: forall a. a -> [a] -> [a]

  class Show a where
    show :: a -> String

  foreign import showStringImpl
    "function showStringImpl(s) {\
    \  return JSON.stringify(s);\
    \}" :: String -> String

  instance showUnit :: Show Unit where
    show (Unit {}) = "Unit {}"

  instance showString :: Show String where
    show = showStringImpl

  instance showBoolean :: Show Boolean where
    show true = "true"
    show false = "false"

  foreign import showNumberImpl "function showNumberImpl(n) {\
                                \  return n.toString();\
                                \}" :: Number -> String

  instance showNumber :: Show Number where
    show = showNumberImpl

  foreign import showArrayImpl
    "function showArrayImpl(f) {\
    \  return function(xs) {\
    \    var ss = [];\
    \    for (var i = 0, l = xs.length; i < l; i++) {\
    \      ss[i] = f(xs[i]);\
    \    }\
    \    return '[' + ss.join(',') + ']';\
    \  };\
    \}" :: forall a. (a -> String) -> [a] -> String

  instance showArray :: (Show a) => Show [a] where
    show = showArrayImpl show

  infixl 4 <$>
  infixl 1 <#>

  class Functor f where
    (<$>) :: forall a b. (a -> b) -> f a -> f b

  (<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b
  (<#>) fa f = f <$> fa

  void :: forall f a. (Functor f) => f a -> f Unit
  void fa = const unit <$> fa

  infixl 4 <*>

  class (Functor f) <= Apply f where
    (<*>) :: forall a b. f (a -> b) -> f a -> f b

  class (Apply f) <= Applicative f where
    pure :: forall a. a -> f a

  liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
  liftA1 f a = pure f <*> a

  infixl 1 >>=

  class (Apply m) <= Bind m where
    (>>=) :: forall a b. m a -> (a -> m b) -> m b

  class (Applicative m, Bind m) <= Monad m

  return :: forall m a. (Monad m) => a -> m a
  return = pure

  liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
  liftM1 f a = do
    a' <- a
    return (f a')

  ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
  ap f a = do
    f' <- f
    a' <- a
    return (f' a')

  instance functorArr :: Functor ((->) r) where
    (<$>) = (<<<)

  instance applyArr :: Apply ((->) r) where
    (<*>) f g x = f x (g x)

  instance applicativeArr :: Applicative ((->) r) where
    pure = const

  instance bindArr :: Bind ((->) r) where
    (>>=) m f x = f (m x) x

  instance monadArr :: Monad ((->) r)

  infixl 7 *
  infixl 7 /
  infixl 7 %

  infixl 6 -
  infixl 6 +

  class Num a where
    (+) :: a -> a -> a
    (-) :: a -> a -> a
    (*) :: a -> a -> a
    (/) :: a -> a -> a
    (%) :: a -> a -> a
    negate :: a -> a

  foreign import numAdd "function numAdd(n1) {\
                        \  return function(n2) {\
                        \    return n1 + n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numSub "function numSub(n1) {\
                        \  return function(n2) {\
                        \    return n1 - n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numMul "function numMul(n1) {\
                        \  return function(n2) {\
                        \    return n1 * n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numDiv "function numDiv(n1) {\
                        \  return function(n2) {\
                        \    return n1 / n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numMod "function numMod(n1) {\
                        \  return function(n2) {\
                        \    return n1 % n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numNegate "function numNegate(n) {\
                           \  return -n;\
                           \}" :: Number -> Number

  instance numNumber :: Num Number where
    (+) = numAdd
    (-) = numSub
    (*) = numMul
    (/) = numDiv
    (%) = numMod
    negate = numNegate

  newtype Unit = Unit {}

  unit :: Unit
  unit = Unit {}

  infix 4 ==
  infix 4 /=

  class Eq a where
    (==) :: a -> a -> Boolean
    (/=) :: a -> a -> Boolean

  foreign import refEq
    "function refEq(r1) {\
    \  return function(r2) {\
    \    return r1 === r2;\
    \  };\
    \}" :: forall a. a -> a -> Boolean

  foreign import refIneq
    "function refIneq(r1) {\
    \  return function(r2) {\
    \    return r1 !== r2;\
    \  };\
    \}" :: forall a. a -> a -> Boolean

  instance eqUnit :: Eq Unit where
    (==) (Unit {}) (Unit {}) = true
    (/=) (Unit {}) (Unit {}) = false

  instance eqString :: Eq String where
    (==) = refEq
    (/=) = refIneq

  instance eqNumber :: Eq Number where
    (==) = refEq
    (/=) = refIneq

  instance eqBoolean :: Eq Boolean where
    (==) = refEq
    (/=) = refIneq

  foreign import eqArrayImpl
    "function eqArrayImpl(f) {\
    \  return function(xs) {\
    \    return function(ys) {\
    \      if (xs.length !== ys.length) return false;\
    \      for (var i = 0; i < xs.length; i++) {\
    \        if (!f(xs[i])(ys[i])) return false;\
    \      }\
    \      return true;\
    \    };\
    \  };\
    \}" :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean

  instance eqArray :: (Eq a) => Eq [a] where
    (==) xs ys = eqArrayImpl (==) xs ys
    (/=) xs ys = not (xs == ys)

  data Ordering = LT | GT | EQ

  instance eqOrdering :: Eq Ordering where
    (==) LT LT = true
    (==) GT GT = true
    (==) EQ EQ = true
    (==) _  _  = false
    (/=) x y = not (x == y)

  instance showOrdering :: Show Ordering where
    show LT = "LT"
    show GT = "GT"
    show EQ = "EQ"

  class (Eq a) <= Ord a where
    compare :: a -> a -> Ordering

  infixl 4 <

  (<) :: forall a. (Ord a) => a -> a -> Boolean
  (<) a1 a2 = case a1 `compare` a2 of
    LT -> true
    _ -> false

  infixl 4 >

  (>) :: forall a. (Ord a) => a -> a -> Boolean
  (>) a1 a2 = case a1 `compare` a2 of
    GT -> true
    _ -> false

  infixl 4 <=

  (<=) :: forall a. (Ord a) => a -> a -> Boolean
  (<=) a1 a2 = case a1 `compare` a2 of
    GT -> false
    _ -> true

  infixl 4 >=

  (>=) :: forall a. (Ord a) => a -> a -> Boolean
  (>=) a1 a2 = case a1 `compare` a2 of
    LT -> false
    _ -> true

  foreign import unsafeCompareImpl
    "function unsafeCompareImpl(lt) {\
    \  return function(eq) {\
    \    return function(gt) {\
    \      return function(x) {\
    \        return function(y) {\
    \          return x < y ? lt : x > y ? gt : eq;\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering

  unsafeCompare :: forall a. a -> a -> Ordering
  unsafeCompare = unsafeCompareImpl LT EQ GT

  instance ordUnit :: Ord Unit where
    compare (Unit {}) (Unit {}) = EQ

  instance ordBoolean :: Ord Boolean where
    compare false false = EQ
    compare false true  = LT
    compare true  true  = EQ
    compare true  false = GT

  instance ordNumber :: Ord Number where
    compare = unsafeCompare

  instance ordString :: Ord String where
    compare = unsafeCompare

  instance ordArray :: (Ord a) => Ord [a] where
    compare [] [] = EQ
    compare [] _ = LT
    compare _ [] = GT
    compare (x:xs) (y:ys) = case compare x y of
      EQ -> compare xs ys
      other -> other

  infixl 10 &
  infixl 10 |
  infixl 10 ^

  class Bits b where
    (&) :: b -> b -> b
    (|) :: b -> b -> b
    (^) :: b -> b -> b
    shl :: b -> Number -> b
    shr :: b -> Number -> b
    zshr :: b -> Number -> b
    complement :: b -> b

  foreign import numShl "function numShl(n1) {\
                        \  return function(n2) {\
                        \    return n1 << n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numShr "function numShr(n1) {\
                        \  return function(n2) {\
                        \    return n1 >> n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numZshr "function numZshr(n1) {\
                          \  return function(n2) {\
                          \    return n1 >>> n2;\
                          \  };\
                          \}" :: Number -> Number -> Number

  foreign import numAnd "function numAnd(n1) {\
                        \  return function(n2) {\
                        \    return n1 & n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numOr "function numOr(n1) {\
                       \  return function(n2) {\
                       \    return n1 | n2;\
                       \  };\
                       \}" :: Number -> Number -> Number

  foreign import numXor "function numXor(n1) {\
                        \  return function(n2) {\
                        \    return n1 ^ n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numComplement "function numComplement(n) {\
                               \  return ~n;\
                               \}" :: Number -> Number

  instance bitsNumber :: Bits Number where
    (&) = numAnd
    (|) = numOr
    (^) = numXor
    shl = numShl
    shr = numShr
    zshr = numZshr
    complement = numComplement

  infixr 2 ||
  infixr 3 &&

  class BoolLike b where
    (&&) :: b -> b -> b
    (||) :: b -> b -> b
    not :: b -> b

  foreign import boolAnd "function boolAnd(b1) {\
                         \  return function(b2) {\
                         \    return b1 && b2;\
                         \  };\
                         \}"  :: Boolean -> Boolean -> Boolean

  foreign import boolOr "function boolOr(b1) {\
                        \  return function(b2) {\
                        \    return b1 || b2;\
                        \  };\
                        \}" :: Boolean -> Boolean -> Boolean

  foreign import boolNot "function boolNot(b) {\
                         \  return !b;\
                         \}" :: Boolean -> Boolean

  instance boolLikeBoolean :: BoolLike Boolean where
    (&&) = boolAnd
    (||) = boolOr
    not = boolNot

  infixr 5 <>

  class Semigroup a where
    (<>) :: a -> a -> a

  foreign import concatString
    "function concatString(s1) {\
    \  return function(s2) {\
    \    return s1 + s2;\
    \  };\
    \}" :: String -> String -> String

  instance semigroupUnit :: Semigroup Unit where
    (<>) (Unit {}) (Unit {}) = Unit {}

  instance semigroupString :: Semigroup String where
    (<>) = concatString

  instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
    (<>) f g = \x -> f x <> g x

  infixr 5 ++

  (++) :: forall s. (Semigroup s) => s -> s -> s
  (++) = (<>)

module Data.Function where

  on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
  on f g x y = g x `f` g y

  foreign import data Fn0 :: * -> *
  foreign import data Fn1 :: * -> * -> *
  foreign import data Fn2 :: * -> * -> * -> *
  foreign import data Fn3 :: * -> * -> * -> * -> *
  foreign import data Fn4 :: * -> * -> * -> * -> * -> *
  foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *
  foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *

  foreign import mkFn0
    "function mkFn0(fn) {\
    \  return function() {\
    \    return fn({});\
    \  };\
    \}" :: forall a. (Unit -> a) -> Fn0 a

  foreign import mkFn1
    "function mkFn1(fn) {\
    \  return function(a) {\
    \    return fn(a);\
    \  };\
    \}" :: forall a b. (a -> b) -> Fn1 a b

  foreign import mkFn2
    "function mkFn2(fn) {\
    \  return function(a, b) {\
    \    return fn(a)(b);\
    \  };\
    \}" :: forall a b c. (a -> b -> c) -> Fn2 a b c

  foreign import mkFn3
    "function mkFn3(fn) {\
    \  return function(a, b, c) {\
    \    return fn(a)(b)(c);\
    \  };\
    \}" :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d

  foreign import mkFn4
    "function mkFn4(fn) {\
    \  return function(a, b, c, d) {\
    \    return fn(a)(b)(c)(d);\
    \  };\
    \}" :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e

  foreign import mkFn5
    "function mkFn5(fn) {\
    \  return function(a, b, c, d, e) {\
    \    return fn(a)(b)(c)(d)(e);\
    \  };\
    \}" :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f

  foreign import mkFn6
    "function mkFn6(fn) {\
    \  return function(a, b, c, d, e, f) {\
    \    return fn(a)(b)(c)(d)(e)(f);\
    \  };\
    \}" :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g

  foreign import mkFn7
    "function mkFn7(fn) {\
    \  return function(a, b, c, d, e, f, g) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g);\
    \  };\
    \}" :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h

  foreign import mkFn8
    "function mkFn8(fn) {\
    \  return function(a, b, c, d, e, f, g, h) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h);\
    \  };\
    \}" :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i

  foreign import mkFn9
    "function mkFn9(fn) {\
    \  return function(a, b, c, d, e, f, g, h, i) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);\
    \  };\
    \}" :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j

  foreign import mkFn10
    "function mkFn10(fn) {\
    \  return function(a, b, c, d, e, f, g, h, i, j) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);\
    \  };\
    \}" :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k

  foreign import runFn0
    "function runFn0(fn) {\
    \  return fn();\
    \}" :: forall a. Fn0 a -> a

  foreign import runFn1
    "function runFn1(fn) {\
    \  return function(a) {\
    \    return fn(a);\
    \  };\
    \}" :: forall a b. Fn1 a b -> a -> b

  foreign import runFn2
    "function runFn2(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return fn(a, b);\
    \    };\
    \  };\
    \}" :: forall a b c. Fn2 a b c -> a -> b -> c

  foreign import runFn3
    "function runFn3(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return fn(a, b, c);\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d

  foreign import runFn4
    "function runFn4(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return fn(a, b, c, d);\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e

  foreign import runFn5
    "function runFn5(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return fn(a, b, c, d, e);\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f

  foreign import runFn6
    "function runFn6(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return fn(a, b, c, d, e, f);\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g

  foreign import runFn7
    "function runFn7(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return fn(a, b, c, d, e, f, g);\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h

  foreign import runFn8
    "function runFn8(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return fn(a, b, c, d, e, f, g, h);\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i

  foreign import runFn9
    "function runFn9(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return function(i) {\
    \                    return fn(a, b, c, d, e, f, g, h, i);\
    \                  };\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j

  foreign import runFn10
    "function runFn10(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return function(i) {\
    \                    return function(j) {\
    \                      return fn(a, b, c, d, e, f, g, h, i, j);\
    \                    };\
    \                  };\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k

module Data.Eq where

  newtype Ref a = Ref a

  liftRef :: forall a b. (a -> a -> b) -> Ref a -> Ref a -> b
  liftRef f (Ref x) (Ref y) = f x y

  instance eqRef :: Eq (Ref a) where
    (==) = liftRef refEq
    (/=) = liftRef refIneq

  instance functorRef :: Functor Ref where
    (<$>) f (Ref x) = Ref (f x)

module Prelude.Unsafe where

  foreign import unsafeIndex
    "function unsafeIndex(xs) {\
    \  return function(n) {\
    \    return xs[n];\
    \  };\
    \}" :: forall a. [a] -> Number -> a

module Control.Monad.Eff where

  foreign import data Eff :: # ! -> * -> *

  foreign import returnE "function returnE(a) {\
                         \  return function() {\
                         \    return a;\
                         \  };\
                         \}" :: forall e a. a -> Eff e a

  foreign import bindE "function bindE(a) {\
                       \  return function(f) {\
                       \    return function() {\
                       \      return f(a())();\
                       \    };\
                       \  };\
                       \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b

  type Pure a = forall e. Eff e a

  foreign import runPure "function runPure(f) {\
                         \  return f();\
                         \}" :: forall a. Pure a -> a

  instance functorEff :: Functor (Eff e) where
    (<$>) = liftA1

  instance applyEff :: Apply (Eff e) where
    (<*>) = ap

  instance applicativeEff :: Applicative (Eff e) where
    pure = returnE

  instance bindEff :: Bind (Eff e) where
    (>>=) = bindE

  instance monadEff :: Monad (Eff e)

  foreign import untilE "function untilE(f) {\
                        \  return function() {\
                        \    while (!f());\
                        \    return {};\
                        \  };\
                        \}" :: forall e. Eff e Boolean -> Eff e Unit

  foreign import whileE "function whileE(f) {\
                        \  return function(a) {\
                        \    return function() {\
                        \      while (f()) {\
                        \        a();\
                        \      }\
                        \      return {};\
                        \    };\
                        \  };\
                        \}" :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit

  foreign import forE "function forE(lo) {\
                      \  return function(hi) {\
                      \    return function(f) {\
                      \      return function() {\
                      \        for (var i = lo; i < hi; i++) {\
                      \          f(i)();\
                      \        }\
                      \      };\
                      \    };\
                      \  };\
                      \}" :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit

  foreign import foreachE "function foreachE(as) {\
                          \  return function(f) {\
                          \    return function() {\
                          \      for (var i = 0; i < as.length; i++) {\
                          \        f(as[i])();\
                          \      }\
                          \    };\
                          \  };\
                          \}" :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit

module Control.Monad.Eff.Unsafe where

  import Control.Monad.Eff

  foreign import unsafeInterleaveEff
    "function unsafeInterleaveEff(f) {\
    \  return f;\
    \}" :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a

module Debug.Trace where

  import Control.Monad.Eff

  foreign import data Trace :: !

  foreign import trace "function trace(s) {\
                       \  return function() {\
                       \    console.log(s);\
                       \    return {};\
                       \  };\
                       \}" :: forall r. String -> Eff (trace :: Trace | r) Unit

  print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
  print o = trace (show o)

module Control.Monad.ST where

  import Control.Monad.Eff

  foreign import data ST :: * -> !

  foreign import data STRef :: * -> * -> *

  foreign import data STArray :: * -> * -> *

  foreign import newSTRef "function newSTRef(val) {\
                          \  return function() {\
                          \    return { value: val };\
                          \  };\
                          \}" :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)

  foreign import readSTRef "function readSTRef(ref) {\
                           \  return function() {\
                           \    return ref.value;\
                           \  };\
                           \}" :: forall a h r. STRef h a -> Eff (st :: ST h | r) a

  foreign import modifySTRef "function modifySTRef(ref) {\
                             \  return function(f) {\
                             \    return function() {\
                             \      return ref.value = f(ref.value);\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a

  foreign import writeSTRef "function writeSTRef(ref) {\
                            \  return function(a) {\
                            \    return function() {\
                            \      return ref.value = a;\
                            \    };\
                            \  };\
                            \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

  foreign import newSTArray "function newSTArray(len) {\
                            \  return function(a) {\
                            \    return function() {\
                            \      var arr = [];\
                            \      for (var i = 0; i < len; i++) {\
                            \        arr[i] = a;\
                            \      };\
                            \      return arr;\
                            \    };\
                            \  };\
                            \}" :: forall a h r. Number -> a -> Eff (st :: ST h | r) (STArray h a)

  foreign import peekSTArray "function peekSTArray(arr) {\
                             \  return function(i) {\
                             \    return function() {\
                             \      return arr[i];\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STArray h a -> Number -> Eff (st :: ST h | r) a

  foreign import pokeSTArray "function pokeSTArray(arr) {\
                             \  return function(i) {\
                             \    return function(a) {\
                             \      return function() {\
                             \        return arr[i] = a;\
                             \      };\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STArray h a -> Number -> a -> Eff (st :: ST h | r) a

  foreign import runST "function runST(f) {\
                       \  return f;\
                       \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a

  foreign import runSTArray "function runSTArray(f) {\
                            \  return f;\
                            \}" :: forall a r. (forall h. Eff (st :: ST h | r) (STArray h a)) -> Eff r [a]

module Prelude
  ( flip
  , const
  , asTypeOf
  , Semigroupoid, (<<<), (>>>)
  , Category, id
  , ($), (#)
  , (:), cons
  , Show, show
  , Functor, (<$>), (<$), ($>), (<#>), void
  , Apply, (<*>)
  , Applicative, pure, liftA1
  , Bind, (>>=)
  , Monad, return, liftM1, ap
  , Num, (+), (-), (*), (/), (%)
  , negate
  , Eq, (==), (/=), refEq, refIneq
  , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
  , Bits, (&), (|), (^), shl, shr, zshr, complement
  , BoolLike, (&&), (||)
  , not
  , Semigroup, (<>), (++)
  , Unit(..), unit
  ) where

  flip :: forall a b c. (a -> b -> c) -> b -> a -> c
  flip f b a = f a b

  const :: forall a b. a -> b -> a
  const a _ = a

  asTypeOf :: forall a. a -> a -> a
  asTypeOf x _ = x

  infixr 9 >>>
  infixr 9 <<<

  class Semigroupoid a where
    (<<<) :: forall b c d. a c d -> a b c -> a b d

  instance semigroupoidArr :: Semigroupoid (->) where
    (<<<) f g x = f (g x)

  (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
  (>>>) f g = g <<< f

  class (Semigroupoid a) <= Category a where
    id :: forall t. a t t

  instance categoryArr :: Category (->) where
    id x = x

  infixr 0 $
  infixl 0 #

  ($) :: forall a b. (a -> b) -> a -> b
  ($) f x = f x

  (#) :: forall a b. a -> (a -> b) -> b
  (#) x f = f x

  infixr 6 :

  (:) :: forall a. a -> [a] -> [a]
  (:) = cons

  foreign import cons
    "function cons(e) {\
    \  return function(l) {\
    \    return [e].concat(l);\
    \  };\
    \}" :: forall a. a -> [a] -> [a]

  class Show a where
    show :: a -> String

  foreign import showStringImpl
    "function showStringImpl(s) {\
    \  return JSON.stringify(s);\
    \}" :: String -> String

  instance showUnit :: Show Unit where
    show (Unit {}) = "Unit {}"

  instance showString :: Show String where
    show = showStringImpl

  instance showBoolean :: Show Boolean where
    show true = "true"
    show false = "false"

  foreign import showNumberImpl "function showNumberImpl(n) {\
                                \  return n.toString();\
                                \}" :: Number -> String

  instance showNumber :: Show Number where
    show = showNumberImpl

  foreign import showArrayImpl
    "function showArrayImpl(f) {\
    \  return function(xs) {\
    \    var ss = [];\
    \    for (var i = 0, l = xs.length; i < l; i++) {\
    \      ss[i] = f(xs[i]);\
    \    }\
    \    return '[' + ss.join(',') + ']';\
    \  };\
    \}" :: forall a. (a -> String) -> [a] -> String

  instance showArray :: (Show a) => Show [a] where
    show = showArrayImpl show

  infixl 4 <$>
  infixl 4 <$
  infixl 4 $>
  infixl 1 <#>

  class Functor f where
    (<$>) :: forall a b. (a -> b) -> f a -> f b

  (<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b
  (<#>) fa f = f <$> fa

  (<$) :: forall f a b. (Functor f) => b -> f a -> f b
  (<$) b fa = const b <$> fa

  ($>) :: forall f a b. (Functor f) => f a -> b -> f b
  ($>) fa b = const b <$> fa

  void :: forall f a. (Functor f) => f a -> f Unit
  void fa = const unit <$> fa

  infixl 4 <*>

  class (Functor f) <= Apply f where
    (<*>) :: forall a b. f (a -> b) -> f a -> f b

  class (Apply f) <= Applicative f where
    pure :: forall a. a -> f a

  liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
  liftA1 f a = pure f <*> a

  infixl 1 >>=

  class (Apply m) <= Bind m where
    (>>=) :: forall a b. m a -> (a -> m b) -> m b

  class (Applicative m, Bind m) <= Monad m

  return :: forall m a. (Monad m) => a -> m a
  return = pure

  liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
  liftM1 f a = do
    a' <- a
    return (f a')

  ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
  ap f a = do
    f' <- f
    a' <- a
    return (f' a')

  instance functorArr :: Functor ((->) r) where
    (<$>) = (<<<)

  instance applyArr :: Apply ((->) r) where
    (<*>) f g x = f x (g x)

  instance applicativeArr :: Applicative ((->) r) where
    pure = const

  instance bindArr :: Bind ((->) r) where
    (>>=) m f x = f (m x) x

  instance monadArr :: Monad ((->) r)

  infixl 7 *
  infixl 7 /
  infixl 7 %

  infixl 6 -
  infixl 6 +

  class Num a where
    (+) :: a -> a -> a
    (-) :: a -> a -> a
    (*) :: a -> a -> a
    (/) :: a -> a -> a
    (%) :: a -> a -> a
    negate :: a -> a

  foreign import numAdd "function numAdd(n1) {\
                        \  return function(n2) {\
                        \    return n1 + n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numSub "function numSub(n1) {\
                        \  return function(n2) {\
                        \    return n1 - n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numMul "function numMul(n1) {\
                        \  return function(n2) {\
                        \    return n1 * n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numDiv "function numDiv(n1) {\
                        \  return function(n2) {\
                        \    return n1 / n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numMod "function numMod(n1) {\
                        \  return function(n2) {\
                        \    return n1 % n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numNegate "function numNegate(n) {\
                           \  return -n;\
                           \}" :: Number -> Number

  instance numNumber :: Num Number where
    (+) = numAdd
    (-) = numSub
    (*) = numMul
    (/) = numDiv
    (%) = numMod
    negate = numNegate

  newtype Unit = Unit {}

  unit :: Unit
  unit = Unit {}

  infix 4 ==
  infix 4 /=

  class Eq a where
    (==) :: a -> a -> Boolean
    (/=) :: a -> a -> Boolean

  foreign import refEq
    "function refEq(r1) {\
    \  return function(r2) {\
    \    return r1 === r2;\
    \  };\
    \}" :: forall a. a -> a -> Boolean

  foreign import refIneq
    "function refIneq(r1) {\
    \  return function(r2) {\
    \    return r1 !== r2;\
    \  };\
    \}" :: forall a. a -> a -> Boolean

  instance eqUnit :: Eq Unit where
    (==) (Unit {}) (Unit {}) = true
    (/=) (Unit {}) (Unit {}) = false

  instance eqString :: Eq String where
    (==) = refEq
    (/=) = refIneq

  instance eqNumber :: Eq Number where
    (==) = refEq
    (/=) = refIneq

  instance eqBoolean :: Eq Boolean where
    (==) = refEq
    (/=) = refIneq

  foreign import eqArrayImpl
    "function eqArrayImpl(f) {\
    \  return function(xs) {\
    \    return function(ys) {\
    \      if (xs.length !== ys.length) return false;\
    \      for (var i = 0; i < xs.length; i++) {\
    \        if (!f(xs[i])(ys[i])) return false;\
    \      }\
    \      return true;\
    \    };\
    \  };\
    \}" :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean

  instance eqArray :: (Eq a) => Eq [a] where
    (==) xs ys = eqArrayImpl (==) xs ys
    (/=) xs ys = not (xs == ys)

  data Ordering = LT | GT | EQ

  instance eqOrdering :: Eq Ordering where
    (==) LT LT = true
    (==) GT GT = true
    (==) EQ EQ = true
    (==) _  _  = false
    (/=) x y = not (x == y)

  instance showOrdering :: Show Ordering where
    show LT = "LT"
    show GT = "GT"
    show EQ = "EQ"

  class (Eq a) <= Ord a where
    compare :: a -> a -> Ordering

  infixl 4 <

  (<) :: forall a. (Ord a) => a -> a -> Boolean
  (<) a1 a2 = case a1 `compare` a2 of
    LT -> true
    _ -> false

  infixl 4 >

  (>) :: forall a. (Ord a) => a -> a -> Boolean
  (>) a1 a2 = case a1 `compare` a2 of
    GT -> true
    _ -> false

  infixl 4 <=

  (<=) :: forall a. (Ord a) => a -> a -> Boolean
  (<=) a1 a2 = case a1 `compare` a2 of
    GT -> false
    _ -> true

  infixl 4 >=

  (>=) :: forall a. (Ord a) => a -> a -> Boolean
  (>=) a1 a2 = case a1 `compare` a2 of
    LT -> false
    _ -> true

  foreign import unsafeCompareImpl
    "function unsafeCompareImpl(lt) {\
    \  return function(eq) {\
    \    return function(gt) {\
    \      return function(x) {\
    \        return function(y) {\
    \          return x < y ? lt : x > y ? gt : eq;\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering

  unsafeCompare :: forall a. a -> a -> Ordering
  unsafeCompare = unsafeCompareImpl LT EQ GT

  instance ordUnit :: Ord Unit where
    compare (Unit {}) (Unit {}) = EQ

  instance ordBoolean :: Ord Boolean where
    compare false false = EQ
    compare false true  = LT
    compare true  true  = EQ
    compare true  false = GT

  instance ordNumber :: Ord Number where
    compare = unsafeCompare

  instance ordString :: Ord String where
    compare = unsafeCompare

  instance ordArray :: (Ord a) => Ord [a] where
    compare [] [] = EQ
    compare [] _ = LT
    compare _ [] = GT
    compare (x:xs) (y:ys) = case compare x y of
      EQ -> compare xs ys
      other -> other

  infixl 10 &
  infixl 10 |
  infixl 10 ^

  class Bits b where
    (&) :: b -> b -> b
    (|) :: b -> b -> b
    (^) :: b -> b -> b
    shl :: b -> Number -> b
    shr :: b -> Number -> b
    zshr :: b -> Number -> b
    complement :: b -> b

  foreign import numShl "function numShl(n1) {\
                        \  return function(n2) {\
                        \    return n1 << n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numShr "function numShr(n1) {\
                        \  return function(n2) {\
                        \    return n1 >> n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numZshr "function numZshr(n1) {\
                          \  return function(n2) {\
                          \    return n1 >>> n2;\
                          \  };\
                          \}" :: Number -> Number -> Number

  foreign import numAnd "function numAnd(n1) {\
                        \  return function(n2) {\
                        \    return n1 & n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numOr "function numOr(n1) {\
                       \  return function(n2) {\
                       \    return n1 | n2;\
                       \  };\
                       \}" :: Number -> Number -> Number

  foreign import numXor "function numXor(n1) {\
                        \  return function(n2) {\
                        \    return n1 ^ n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numComplement "function numComplement(n) {\
                               \  return ~n;\
                               \}" :: Number -> Number

  instance bitsNumber :: Bits Number where
    (&) = numAnd
    (|) = numOr
    (^) = numXor
    shl = numShl
    shr = numShr
    zshr = numZshr
    complement = numComplement

  infixr 2 ||
  infixr 3 &&

  class BoolLike b where
    (&&) :: b -> b -> b
    (||) :: b -> b -> b
    not :: b -> b

  foreign import boolAnd "function boolAnd(b1) {\
                         \  return function(b2) {\
                         \    return b1 && b2;\
                         \  };\
                         \}"  :: Boolean -> Boolean -> Boolean

  foreign import boolOr "function boolOr(b1) {\
                        \  return function(b2) {\
                        \    return b1 || b2;\
                        \  };\
                        \}" :: Boolean -> Boolean -> Boolean

  foreign import boolNot "function boolNot(b) {\
                         \  return !b;\
                         \}" :: Boolean -> Boolean

  instance boolLikeBoolean :: BoolLike Boolean where
    (&&) = boolAnd
    (||) = boolOr
    not = boolNot

  infixr 5 <>

  class Semigroup a where
    (<>) :: a -> a -> a

  foreign import concatString
    "function concatString(s1) {\
    \  return function(s2) {\
    \    return s1 + s2;\
    \  };\
    \}" :: String -> String -> String

  instance semigroupUnit :: Semigroup Unit where
    (<>) (Unit {}) (Unit {}) = Unit {}

  instance semigroupString :: Semigroup String where
    (<>) = concatString

  instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
    (<>) f g = \x -> f x <> g x

  infixr 5 ++

  (++) :: forall s. (Semigroup s) => s -> s -> s
  (++) = (<>)

module Data.Function where

  on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
  on f g x y = g x `f` g y

  foreign import data Fn0 :: * -> *
  foreign import data Fn1 :: * -> * -> *
  foreign import data Fn2 :: * -> * -> * -> *
  foreign import data Fn3 :: * -> * -> * -> * -> *
  foreign import data Fn4 :: * -> * -> * -> * -> * -> *
  foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *
  foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *

  foreign import mkFn0
    "function mkFn0(fn) {\
    \  return function() {\
    \    return fn({});\
    \  };\
    \}" :: forall a. (Unit -> a) -> Fn0 a

  foreign import mkFn1
    "function mkFn1(fn) {\
    \  return function(a) {\
    \    return fn(a);\
    \  };\
    \}" :: forall a b. (a -> b) -> Fn1 a b

  foreign import mkFn2
    "function mkFn2(fn) {\
    \  return function(a, b) {\
    \    return fn(a)(b);\
    \  };\
    \}" :: forall a b c. (a -> b -> c) -> Fn2 a b c

  foreign import mkFn3
    "function mkFn3(fn) {\
    \  return function(a, b, c) {\
    \    return fn(a)(b)(c);\
    \  };\
    \}" :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d

  foreign import mkFn4
    "function mkFn4(fn) {\
    \  return function(a, b, c, d) {\
    \    return fn(a)(b)(c)(d);\
    \  };\
    \}" :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e

  foreign import mkFn5
    "function mkFn5(fn) {\
    \  return function(a, b, c, d, e) {\
    \    return fn(a)(b)(c)(d)(e);\
    \  };\
    \}" :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f

  foreign import mkFn6
    "function mkFn6(fn) {\
    \  return function(a, b, c, d, e, f) {\
    \    return fn(a)(b)(c)(d)(e)(f);\
    \  };\
    \}" :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g

  foreign import mkFn7
    "function mkFn7(fn) {\
    \  return function(a, b, c, d, e, f, g) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g);\
    \  };\
    \}" :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h

  foreign import mkFn8
    "function mkFn8(fn) {\
    \  return function(a, b, c, d, e, f, g, h) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h);\
    \  };\
    \}" :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i

  foreign import mkFn9
    "function mkFn9(fn) {\
    \  return function(a, b, c, d, e, f, g, h, i) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);\
    \  };\
    \}" :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j

  foreign import mkFn10
    "function mkFn10(fn) {\
    \  return function(a, b, c, d, e, f, g, h, i, j) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);\
    \  };\
    \}" :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k

  foreign import runFn0
    "function runFn0(fn) {\
    \  return fn();\
    \}" :: forall a. Fn0 a -> a

  foreign import runFn1
    "function runFn1(fn) {\
    \  return function(a) {\
    \    return fn(a);\
    \  };\
    \}" :: forall a b. Fn1 a b -> a -> b

  foreign import runFn2
    "function runFn2(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return fn(a, b);\
    \    };\
    \  };\
    \}" :: forall a b c. Fn2 a b c -> a -> b -> c

  foreign import runFn3
    "function runFn3(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return fn(a, b, c);\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d

  foreign import runFn4
    "function runFn4(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return fn(a, b, c, d);\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e

  foreign import runFn5
    "function runFn5(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return fn(a, b, c, d, e);\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f

  foreign import runFn6
    "function runFn6(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return fn(a, b, c, d, e, f);\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g

  foreign import runFn7
    "function runFn7(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return fn(a, b, c, d, e, f, g);\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h

  foreign import runFn8
    "function runFn8(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return fn(a, b, c, d, e, f, g, h);\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i

  foreign import runFn9
    "function runFn9(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return function(i) {\
    \                    return fn(a, b, c, d, e, f, g, h, i);\
    \                  };\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j

  foreign import runFn10
    "function runFn10(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return function(i) {\
    \                    return function(j) {\
    \                      return fn(a, b, c, d, e, f, g, h, i, j);\
    \                    };\
    \                  };\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k

module Data.Eq where

  newtype Ref a = Ref a

  liftRef :: forall a b. (a -> a -> b) -> Ref a -> Ref a -> b
  liftRef f (Ref x) (Ref y) = f x y

  instance eqRef :: Eq (Ref a) where
    (==) = liftRef refEq
    (/=) = liftRef refIneq

  instance functorRef :: Functor Ref where
    (<$>) f (Ref x) = Ref (f x)

module Prelude.Unsafe where

  foreign import unsafeIndex
    "function unsafeIndex(xs) {\
    \  return function(n) {\
    \    return xs[n];\
    \  };\
    \}" :: forall a. [a] -> Number -> a

module Control.Monad.Eff where

  foreign import data Eff :: # ! -> * -> *

  foreign import returnE "function returnE(a) {\
                         \  return function() {\
                         \    return a;\
                         \  };\
                         \}" :: forall e a. a -> Eff e a

  foreign import bindE "function bindE(a) {\
                       \  return function(f) {\
                       \    return function() {\
                       \      return f(a())();\
                       \    };\
                       \  };\
                       \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b

  type Pure a = forall e. Eff e a

  foreign import runPure "function runPure(f) {\
                         \  return f();\
                         \}" :: forall a. Pure a -> a

  instance functorEff :: Functor (Eff e) where
    (<$>) = liftA1

  instance applyEff :: Apply (Eff e) where
    (<*>) = ap

  instance applicativeEff :: Applicative (Eff e) where
    pure = returnE

  instance bindEff :: Bind (Eff e) where
    (>>=) = bindE

  instance monadEff :: Monad (Eff e)

  foreign import untilE "function untilE(f) {\
                        \  return function() {\
                        \    while (!f());\
                        \    return {};\
                        \  };\
                        \}" :: forall e. Eff e Boolean -> Eff e Unit

  foreign import whileE "function whileE(f) {\
                        \  return function(a) {\
                        \    return function() {\
                        \      while (f()) {\
                        \        a();\
                        \      }\
                        \      return {};\
                        \    };\
                        \  };\
                        \}" :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit

  foreign import forE "function forE(lo) {\
                      \  return function(hi) {\
                      \    return function(f) {\
                      \      return function() {\
                      \        for (var i = lo; i < hi; i++) {\
                      \          f(i)();\
                      \        }\
                      \      };\
                      \    };\
                      \  };\
                      \}" :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit

  foreign import foreachE "function foreachE(as) {\
                          \  return function(f) {\
                          \    return function() {\
                          \      for (var i = 0; i < as.length; i++) {\
                          \        f(as[i])();\
                          \      }\
                          \    };\
                          \  };\
                          \}" :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit

module Control.Monad.Eff.Unsafe where

  import Control.Monad.Eff

  foreign import unsafeInterleaveEff
    "function unsafeInterleaveEff(f) {\
    \  return f;\
    \}" :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a

module Debug.Trace where

  import Control.Monad.Eff

  foreign import data Trace :: !

  foreign import trace "function trace(s) {\
                       \  return function() {\
                       \    console.log(s);\
                       \    return {};\
                       \  };\
                       \}" :: forall r. String -> Eff (trace :: Trace | r) Unit

  print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
  print o = trace (show o)

module Control.Monad.ST where

  import Control.Monad.Eff

  foreign import data ST :: * -> !

  foreign import data STRef :: * -> * -> *

  foreign import data STArray :: * -> * -> *

  foreign import newSTRef "function newSTRef(val) {\
                          \  return function() {\
                          \    return { value: val };\
                          \  };\
                          \}" :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)

  foreign import readSTRef "function readSTRef(ref) {\
                           \  return function() {\
                           \    return ref.value;\
                           \  };\
                           \}" :: forall a h r. STRef h a -> Eff (st :: ST h | r) a

  foreign import modifySTRef "function modifySTRef(ref) {\
                             \  return function(f) {\
                             \    return function() {\
                             \      return ref.value = f(ref.value);\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a

  foreign import writeSTRef "function writeSTRef(ref) {\
                            \  return function(a) {\
                            \    return function() {\
                            \      return ref.value = a;\
                            \    };\
                            \  };\
                            \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

  foreign import newSTArray "function newSTArray(len) {\
                            \  return function(a) {\
                            \    return function() {\
                            \      var arr = [];\
                            \      for (var i = 0; i < len; i++) {\
                            \        arr[i] = a;\
                            \      };\
                            \      return arr;\
                            \    };\
                            \  };\
                            \}" :: forall a h r. Number -> a -> Eff (st :: ST h | r) (STArray h a)

  foreign import peekSTArray "function peekSTArray(arr) {\
                             \  return function(i) {\
                             \    return function() {\
                             \      return arr[i];\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STArray h a -> Number -> Eff (st :: ST h | r) a

  foreign import pokeSTArray "function pokeSTArray(arr) {\
                             \  return function(i) {\
                             \    return function(a) {\
                             \      return function() {\
                             \        return arr[i] = a;\
                             \      };\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STArray h a -> Number -> a -> Eff (st :: ST h | r) a

  foreign import runST "function runST(f) {\
                       \  return f;\
                       \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a

  foreign import runSTArray "function runSTArray(f) {\
                            \  return f;\
                            \}" :: forall a r. (forall h. Eff (st :: ST h | r) (STArray h a)) -> Eff r [a]


[WIP]

[WIP]

module PSWC where

import Prelude

import Control.Monad.Aff (Aff, Fiber, launchAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Except (runExcept)
import CoreFn.FromJSON (moduleFromJSON)
import Data.Array as Array
import Data.Either (Either(..))
import Data.Foldable (foldr, for_)
import Data.List (List(..), (:))
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Monoid (guard)
import Data.Newtype (unwrap)
import Data.Path.Pathy (Dir, DirName(DirName), Path, Rel, Sandboxed, currentDir, dir, dir', file, parseRelFile, printPath, runDirName, sandbox, (<.>), (</>))
import Data.String as S
import Data.Traversable (traverse)
import Data.Trie (Trie(..), fromPaths)
import Data.Trie as Trie
-- import Debug.Trace (trace)
import Node.Encoding (Encoding(..))
import Node.FS (FS)
import Node.FS.Aff (exists, readTextFile, readdir, stat)
import Node.FS.Stats (isDirectory)
import Node.Path (FilePath)
import PureSwift.AST (AccessMod(..), Decl(..), DeclMod(..), Ident(..))
import PureSwift.CodeGen (moduleToSwift)
import PureSwift.PrettyPrinter (prettyPrint)

type Effects eff =
  ( fs :: FS
  , console :: CONSOLE
  | eff
  )

dryRun :: forall eff. Trie -> String -> String -> Eff (console :: CONSOLE | eff) Unit
dryRun (Trie trie) ffis codegens = do
  for_ trie \(Trie.Path path) ->
    case Array.unsnoc path of
      Just { init, last } -> do
        log $ "// " <> Array.intercalate "." path <> "__Namespace.swift"
        let
          enum = Enum (AccessModifier Public : Nil) (Ident last) Nil
          decl = if Array.null init then enum else Extension (AccessModifier Public : Nil) (Ident $ Array.intercalate "." init) (enum : Nil)
        log $ prettyPrint decl <> "\n"
      Nothing -> pure unit
  log ffis
  log codegens

type State =
  { moduleNamePaths :: Array Trie.Path
  , ffis :: String
  , codegens :: String
  }

toPaths :: forall eff. Array FilePath -> Aff (Effects eff) State
toPaths = foldr acc (pure { moduleNamePaths: [], ffis: "", codegens: "" })
  where
    acc
      :: String
      -> Aff (Effects eff) State
      -> Aff (Effects eff) State
    acc filename state = do
      { moduleNamePaths, ffis, codegens } <- state
      let
        moduleDir :: Path Rel Dir Sandboxed
        moduleDir = dir' outputDir </> dir filename

        hidden :: Boolean
        hidden = maybe false (S.singleton >>> (_ == ".")) $ S.charAt 0 filename

        when
          :: Boolean
          -> Aff (Effects eff) State
          -> Aff (Effects eff) State
        when true m = m
        when false _ = state

        whenM
          :: Aff (Effects eff) Boolean
          -> Aff (Effects eff) State
          -> Aff (Effects eff) State
        whenM mb m = do
          b <- mb
          when b m

      when (not hidden) do
        stat <- stat $ printPath moduleDir

        when (isDirectory stat) do
          let filepath = printPath $ moduleDir </> file "corefn.json"
          -- trace ("------") \_ ->
          -- trace ("filepath" <> show filepath) \_ ->

          whenM (exists filepath) do
            -- moduleNamePaths' <- moduleNamePaths
            coreFn <- readTextFile UTF8 filepath
            case runExcept (moduleFromJSON coreFn) of
              Left e ->
                -- trace ("Left: " <> show e) \_->
                state
              Right { module: module_ } -> do
                let
                  { moduleForeign, moduleName, modulePath } = unwrap module_
                  codegen = prettyPrint $ moduleToSwift module_
                  -- codegen = prettyPrint $ moduleToSwift $ trace ("module_: " <> show module_) \_ -> module_
                  -- codegen = prettyPrint $ trace (show $ moduleToSwift module_) \_ -> moduleToSwift module_

                  hasForeign = not Array.null moduleForeign
                  ffiPath = if hasForeign then map (_ <.> "swift") (sandbox currentDir =<< parseRelFile (unwrap modulePath)) else Nothing
                  -- foo = trace ("ffiPath: " <> show (map printPath ffiPath)) \_ -> unit

                ffi <- traverse (printPath >>> readTextFile UTF8) ffiPath
                -- let bar = trace ("ffi: " <> show ffi) \_ -> unit

                let
                  moduleNamePath = Trie.Path $ map unwrap $ unwrap moduleName
                  foreignNamePaths = guard hasForeign [moduleNamePath <> Trie.Path ["_Foreign"]]
                  namePaths = [moduleNamePath] <> foreignNamePaths

                pure $
                  { moduleNamePaths: namePaths <> moduleNamePaths
                  , ffis: fromMaybe "" ffi <> "\n" <> ffis
                  , codegens: codegen <> "\n" <> codegens
                  }

outputDir :: DirName
outputDir = DirName "output"

-- pulp build -- --dump-corefn
main :: forall eff. Eff (Effects eff) (Fiber (Effects eff) Unit)
main = launchAff do
  files <- readdir $ runDirName outputDir
  { moduleNamePaths, ffis, codegens } <- toPaths files
  let trie = fromPaths moduleNamePaths
  liftEff $ dryRun trie ffis codegens

module PSWC where

import Prelude

import Control.Monad.Aff (Aff, Fiber, launchAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Except (runExcept)
import CoreFn.FromJSON (moduleFromJSON)
import Data.Array as Array
import Data.Either (Either(..))
import Data.Foldable (foldr, for_)
import Data.List (List(..), (:))
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Monoid (guard)
import Data.Newtype (unwrap)
import Data.Path.Pathy (Dir, DirName(DirName), Path, Rel, Sandboxed, currentDir, dir, dir', file, parseRelFile, printPath, runDirName, sandbox, (<.>), (</>))
import Data.String as S
import Data.Traversable (traverse)
import Data.Trie (Trie(..), fromPaths)
import Data.Trie as Trie
import Debug.Trace (trace)
import Node.Encoding (Encoding(..))
import Node.FS (FS)
import Node.FS.Aff (exists, readTextFile, readdir, stat)
import Node.FS.Stats (isDirectory)
import Node.Path (FilePath)
import PureSwift.AST (AccessMod(..), Decl(..), DeclMod(..), Ident(..))
import PureSwift.CodeGen (moduleToSwift)
import PureSwift.PrettyPrinter (prettyPrint)

type Effects eff =
  ( fs :: FS
  , console :: CONSOLE
  | eff
  )

dryRun :: forall eff. Trie -> String -> String -> Eff (console :: CONSOLE | eff) Unit
dryRun (Trie trie) ffis codegens = do
  for_ trie \(Trie.Path path) ->
    case Array.unsnoc path of
      Just { init, last } -> do
        log $ "// " <> Array.intercalate "." path <> "__Namespace.swift"
        let
          enum = Enum (AccessModifier Public : Nil) (Ident last) Nil
          decl = if Array.null init then enum else Extension (AccessModifier Public : Nil) (Ident $ Array.intercalate "." init) (enum : Nil)
        log $ prettyPrint decl <> "\n"
      Nothing -> pure unit
  log ffis
  log codegens

type State =
  { moduleNamePaths :: Array Trie.Path
  , ffis :: String
  , codegens :: String
  }

toPaths :: forall eff. Array FilePath -> Aff (Effects eff) State
toPaths = foldr acc (pure { moduleNamePaths: [], ffis: "", codegens: "" })
  where
    acc
      :: String
      -> Aff (Effects eff) State
      -> Aff (Effects eff) State
    acc filename state = do
      { moduleNamePaths, ffis, codegens } <- state
      let
        moduleDir :: Path Rel Dir Sandboxed
        moduleDir = dir' outputDir </> dir filename

        hidden :: Boolean
        hidden = maybe false (S.singleton >>> (_ == ".")) $ S.charAt 0 filename

        when
          :: Boolean
          -> Aff (Effects eff) State
          -> Aff (Effects eff) State
        when true m = m
        when false _ = state

        whenM
          :: Aff (Effects eff) Boolean
          -> Aff (Effects eff) State
          -> Aff (Effects eff) State
        whenM mb m = do
          b <- mb
          when b m

      when (not hidden) do
        stat <- stat $ printPath moduleDir

        when (isDirectory stat) do
          let filepath = printPath $ moduleDir </> file "corefn.json"
          -- trace ("------") \_ ->
          -- trace ("filepath" <> show filepath) \_ ->

          whenM (exists filepath) do
            -- moduleNamePaths' <- moduleNamePaths
            coreFn <- readTextFile UTF8 filepath
            case runExcept (moduleFromJSON coreFn) of
              Left e ->
                -- trace ("Left: " <> show e) \_->
                state
              Right { module: module_ } -> do
                -- trace ("Right: " <> show module_.moduleForeign) \_ ->
                let
                  { moduleForeign, moduleName, modulePath } = unwrap module_
                  codegen = prettyPrint $ moduleToSwift module_

                  hasForeign = not Array.null moduleForeign
                  ffiPath = if hasForeign then map (_ <.> "swift") (sandbox currentDir =<< parseRelFile (unwrap modulePath)) else Nothing
                  foo = trace ("ffiPath: " <> show (map printPath ffiPath)) \_ -> unit

                ffi <- traverse (printPath >>> readTextFile UTF8) ffiPath
                let bar = trace ("ffi: " <> show ffi) \_ -> unit

                let
                  moduleNamePath = Trie.Path $ map unwrap $ unwrap moduleName
                  foreignNamePaths = guard hasForeign [moduleNamePath <> Trie.Path ["_Foreign"]]
                  namePaths = [moduleNamePath] <> foreignNamePaths

                pure $
                  { moduleNamePaths: namePaths <> moduleNamePaths
                  , ffis: fromMaybe "" ffi <> "\n" <> ffis
                  , codegens: codegen <> "\n" <> codegens
                  }

outputDir :: DirName
outputDir = DirName "output"

-- pulp build -- --dump-corefn
main :: forall eff. Eff (Effects eff) (Fiber (Effects eff) Unit)
main = launchAff do
  files <- readdir $ runDirName outputDir
  { moduleNamePaths, ffis, codegens } <- toPaths files
  let trie = fromPaths moduleNamePaths
  liftEff $ dryRun trie ffis codegens


add class for taking the non-overlapping union of two rows

module Genetics.Browser.Track
       ( class TrackRecord
       , buildTrack
       , makeTrack
       , TrackConfigRecord
       , class TrackConfig
       , makeContainersImpl
       , makeContainers
       , class TrackData
       , fetchDataImpl
       , fetchData
       , class CombineFuns
       , combineFunsImpl
       , combineFuns
       ) where

import Prelude

import Data.Foldable (foldMap)
import Data.Maybe (Maybe)
import Data.Pair (Pair)
import Effect (Effect)
import Effect.Aff (Aff)
import Genetics.Browser.Canvas (TrackContainer, trackContainer, withLoadingIndicator)
import Genetics.Browser.Coordinates (CoordSysView)
import Genetics.Browser.Layer (TrackPadding)
import Genetics.Browser.Types (Point)
import Prim.Boolean (False, True, kind Boolean)
import Prim.Row as Row
import Prim.RowList (class RowToList, Cons, Nil, kind RowList)
import Prim.TypeError (class Fail, Text)
import Record (delete, get, insert)
import Type.Data.Boolean as Boolean
import Type.Data.Symbol as Symbol
import Type.Prelude (class IsSymbol, class TypeEquals, Proxy(..), RLProxy(..), RProxy(..), SProxy(..), from)
import Unsafe.Coerce (unsafeCoerce)

type TrackInterface a =
  { render   :: Pair Number -> CoordSysView -> Aff Unit
  , hotspots :: Aff (Number -> Point -> Array a) }

class TrackRecord
      (trackList :: RowList)
      (trackRow :: # Type)
      a
      | trackList -> trackRow
      , trackList -> a where
  buildTrack :: RLProxy trackList
             -> Record trackRow
             -> TrackContainer
             -> Aff { render   :: Pair Number -> CoordSysView -> Aff Unit
                    , hotspots :: Aff (Number -> Point -> Array a) }

instance trackRecordRender ::
  ( IsSymbol  name
  , Row.Lacks name trackRow'
  , Row.Cons  name (Pair Number -> CoordSysView -> Aff Unit) trackRow' trackRow
  , TrackRecord trackTail trackRow' a
  ) => TrackRecord (Cons name (Pair Number -> CoordSysView -> Aff Unit) trackTail) trackRow a where
  buildTrack _ r tcont = do

    let name = SProxy :: SProxy name

    rest <- buildTrack (RLProxy :: RLProxy trackTail)
                       (delete name r) tcont

    let rLayer p c = (get name r) p c

    pure { render:   rLayer <> rest.render
         , hotspots: rest.hotspots }

instance trackRecordUI ::
  ( IsSymbol  name
  , Row.Lacks name trackRow'
  , Row.Cons  name (Aff Unit) trackRow' trackRow
  , TrackRecord trackTail trackRow' a
  ) => TrackRecord (Cons name (Aff Unit) trackTail) trackRow a where
  buildTrack _ r tcont = do

    let name = SProxy :: SProxy name

    rest <- buildTrack (RLProxy :: RLProxy trackTail)
                       (delete name r) tcont

    let rLayer _ _ = (get name r)

    pure { render:   rLayer <> rest.render
         , hotspots: rest.hotspots }

instance trackRecordHotspots ::
  ( IsSymbol  name
  , Row.Lacks name trackRow'
  , Row.Cons  name (Aff (Number -> pt -> Array a)) trackRow' trackRow
  , TypeEquals pt Point
  , TrackRecord trackTail trackRow' a
  ) => TrackRecord (Cons name (Aff (Number -> pt -> Array a)) trackTail) trackRow a where
  buildTrack _ r tcont = do

    let name = SProxy :: SProxy name

    rest <- buildTrack (RLProxy :: RLProxy trackTail)
                       (delete name r) tcont

    let hotspots = ado
          h  <- get name r
          h' <- rest.hotspots
          in \rad p -> h rad (from p) <> h' rad p

    pure { render: rest.render, hotspots }

instance trackRecordNil ::
  ( TypeEquals (Record trackRow) {}
  ) => TrackRecord Nil trackRow a where
  buildTrack _ _ _ = mempty

makeTrack :: ∀ row list a.
             RowToList row list
          => TrackRecord list row a
          => Record row
          -> TrackContainer
          -> Aff (TrackInterface a)
makeTrack r c = buildTrack (RLProxy :: RLProxy list) r c

type TrackConfigRecord r =
  { trackHeight :: Number
  , padding :: TrackPadding | r }

class TrackConfig
  (confList :: RowList)
  (confRow  :: # Type)
  (trackRow :: # Type)
  | confList -> confRow trackRow
  where
  makeContainersImpl :: RLProxy confList
                     -> Number
                     -> Record confRow
                     -> Effect (Record trackRow)

instance trackConfigNil ::
  ( TypeEquals (Record tr) {}
  ) => TrackConfig Nil cr tr where
  makeContainersImpl _ _ _ = pure $ from {}

instance trackConfigCons ::
  ( IsSymbol name
  , TrackConfig tail confRow' trackRow'
  , Row.Cons name c confRow' confRow
  , Row.Lacks name confRow'
  , Row.Cons name TrackContainer trackRow' trackRow
  , Row.Lacks name trackRow'
  , TypeEquals (TrackConfigRecord we) c
  ) => TrackConfig (Cons name c tail) confRow trackRow where
  makeContainersImpl _ width r = do
    let n = SProxy :: SProxy name

        c :: TrackConfigRecord we
        c = from $ get n r

    cont <- trackContainer
              {width, height: c.trackHeight}
              c.padding
              (Symbol.reflectSymbol n)

    rest <- makeContainersImpl
              (RLProxy :: RLProxy tail)
              width
              (delete n $ from r)

    pure $ insert n cont rest

makeContainers :: ∀ cl cr tr.
                  RowToList cr cl
               => TrackConfig cl cr tr
               => Number
               -> Record cr
               -> Effect (Record tr)
makeContainers = makeContainersImpl (RLProxy :: RLProxy cl)

class TrackData
      (fetcherList :: RowList)
      (fetcherRow :: # Type)
      (urlRow :: # Type)
      (dataRow :: # Type)
      | fetcherList -> fetcherRow
      , fetcherList -> urlRow
      , fetcherList -> dataRow where
  fetchDataImpl :: RLProxy fetcherList
            -> Record fetcherRow
            -> Record urlRow
            -> Aff (Record dataRow)

instance trackDataCons ::
  ( IsSymbol  name
  , Row.Lacks name fetcherRow'
  , Row.Cons  name (String -> Aff x) fetcherRow' fetcherRow
  , Monoid x
  , Row.Cons  name (Maybe String) urlRow' urlRow
  , Row.Lacks name dataRow'
  , Row.Cons  name x dataRow' dataRow
  , TrackData fetcherTail fetcherRow' urlRow dataRow'
  ) => TrackData (Cons name (String -> Aff x) fetcherTail)
                 fetcherRow
                 urlRow
                 dataRow where
  fetchDataImpl _ fetchers urls = do
    let name = SProxy :: _ name

    rest <- fetchDataImpl (RLProxy :: _ fetcherTail)
                          (delete name fetchers)
                          urls

    dataset <- foldMap (get name fetchers) (get name urls)

    pure $ insert name dataset rest

instance trackDataNil ::
  ( TypeEquals (Record dataRow) {}
  ) => TrackData Nil () urlRow dataRow where
  fetchDataImpl _ _ _ = pure $ from {}

-- | `fetchData` puts a loading indicator in the provided TrackContainer,
-- | fetches the data in the provided `urlRow` record, and parses it
-- | using the parsers in the provided `parserRow` record.
fetchData :: ∀ fetcherRow fetcherList urlRow urlList dataRow.
             RowToList fetcherRow fetcherList
          => RowToList urlRow urlList
          => TrackData fetcherList fetcherRow urlRow dataRow
          => TrackContainer
          -> Record fetcherRow
          -> Record urlRow
          -> Aff (Record dataRow)
fetchData tc fs urls = withLoadingIndicator tc
                       $ fetchDataImpl (RLProxy :: _ fetcherList)
                                       fs
                                       urls

-- | Combine a record of functions from records,
-- | into a function from a record of their union,
-- | to a record of their outputs.
-- | E.g. `{f :: Record r1 -> a, g :: Record r2 -> b}`
-- | into `Record (r1 + r2) -> { f :: a, g :: b }`
class CombineFuns
  (funsList :: RowList)
  (funsRow :: # Type)
  (argRow :: # Type)
  (outRow :: # Type)
  | funsList -> funsRow
  , funsList -> argRow
  , funsList -> outRow where
  combineFunsImpl :: RLProxy funsList
              -> Record funsRow
              -> Record argRow
              -> Record outRow

instance combineFunCons ::
  ( IsSymbol  name
  , Row.Lacks name funsRow'
  , Row.Cons  name (Record r -> a) funsRow' funsRow
  , Row.Union argRow' r argRowUnion
  , Row.Nub   argRowUnion argRowNubbed
  , Row.Lacks name outRow'
  , Row.Cons  name a outRow' outRow
  , CombineFuns funsTail funsRow' argRow' outRow'
  ) => CombineFuns (Cons name (Record r -> a) funsTail)
                  funsRow
                  argRowNubbed
                  outRow where
  combineFunsImpl _ funs args =
    let name = SProxy :: _ name

        thoseArgs :: Record argRow'
        thoseArgs = unsafeCoerce args

        theseArgs :: Record r
        theseArgs = unsafeCoerce args

        rest = combineFunsImpl (RLProxy :: _ funsTail)
                               (delete name funs)
                               thoseArgs
        fn = (get name funs)

    in (insert name (fn theseArgs) rest)

instance combineFunNil ::
  ( TypeEquals (Record outRow) {}
  ) => CombineFuns Nil () () outRow where
  combineFunsImpl _ _ _ = from {}

-- | Note! this isn't actually type safe yet.
-- | If two functions use arguments with the same label
-- | but different types, things break...
combineFuns :: ∀ funsList funsRow argRow outRow.
               RowToList funsRow funsList
            => CombineFuns funsList funsRow argRow outRow
            => Record funsRow
            -> Record argRow
            -> Record outRow
combineFuns funs args = combineFunsImpl (RLProxy :: _ funsList) funs args

class BuildLayers
  (layers :: # Type)
  (output :: # Type)
  | layers -> output

class GetBrowserConfig
  (totalConfig :: # Type)
  (browser :: # Type)
  | totalConfig -> browser where
    getBrowserConfigImpl :: Record totalConfig
                         -> Record browser

instance getBrowserConfig ::
  ( IsSymbol sBrowser
  , TypeEquals (SProxy sBrowser) (SProxy "browser")
  , IsSymbol sLayers
  , TypeEquals (SProxy sLayers) (SProxy "layers")

  , Row.Cons sBrowser (Record browser') totalConfig' totalConfig
  , Row.Lacks sBrowser totalConfig'

  , Row.Cons sLayers layers browser browser'
  , Row.Lacks sLayers browser
  ) => GetBrowserConfig totalConfig browser where
  getBrowserConfigImpl total =
    let browser' :: Record browser'
        browser' = get (from (SProxy :: _ "browser")) total
    in delete (from (SProxy :: _ "layers")) browser'

class GetTrackConfig
  (totalConfig :: # Type)
  (track :: # Type)
  (trackName :: Symbol)
  | totalConfig trackName -> track where
    getTrackConfigImpl :: Record totalConfig
                       -> SProxy trackName
                       -> Record track

instance getTrackConfig ::
  ( IsSymbol sTracks
  , TypeEquals (SProxy sTracks) (SProxy "tracks")
  , IsSymbol sLayers
  , TypeEquals (SProxy sLayers) (SProxy "layers")
  , IsSymbol trackName

  , Row.Cons sTracks (Record tracks) totalConfig' totalConfig
  , Row.Lacks sTracks totalConfig'

  , Row.Cons trackName (Record thisTrack') tracks' tracks
  , Row.Lacks trackName tracks'

  , Row.Cons sLayers layers thisTrack thisTrack'
  , Row.Lacks sLayers thisTrack

  ) => GetTrackConfig totalConfig thisTrack trackName where
    getTrackConfigImpl total _ =
      let tracks' :: Record tracks
          tracks' = get (from (SProxy :: _ "tracks")) total

          thisTrack :: Record thisTrack'
          thisTrack = get (from (SProxy :: _ trackName)) tracks'

      in delete (from (SProxy :: _ "layers")) thisTrack

class GetLayerConfig
  (totalConfig :: # Type)
  (layer :: # Type)
  (trackName :: Symbol)
  (layerName :: Symbol)
  | totalConfig trackName layerName -> layer where
    getLayerConfigImpl :: Record totalConfig
                       -> SProxy trackName
                       -> SProxy layerName
                       -> Record layer

instance getLayerConfig ::
  ( IsSymbol sTracks
  , TypeEquals (SProxy sTracks) (SProxy "tracks")
  , IsSymbol sLayers
  , TypeEquals (SProxy sLayers) (SProxy "layers")
  , IsSymbol trackName
  , IsSymbol layerName

  , Row.Cons sTracks (Record tracks) totalConfig' totalConfig
  , Row.Lacks sTracks totalConfig'

  , Row.Cons trackName (Record thisTrack) tracks' tracks
  , Row.Lacks trackName tracks'

  , Row.Cons sLayers (Record layers) thisTrack' thisTrack
  , Row.Lacks sLayers thisTrack

  , Row.Cons layerName (Record thisLayer) layers' layers
  , Row.Lacks layerName layers'
  ) => GetLayerConfig totalConfig thisLayer trackName layerName where
    getLayerConfigImpl total _ _ =
      let tracks' :: Record tracks
          tracks' = get (from (SProxy :: _ "tracks")) total

          thisTrack :: Record thisTrack
          thisTrack = get (from (SProxy :: _ trackName)) tracks'

          layers :: Record layers
          layers = get (from (SProxy :: _ "layers")) thisTrack

      in get (from (SProxy :: _ layerName)) layers

newtype LayerDef browser track layer a
  = LayerDef ({ browserConfig :: Record browser
              , trackConfig :: Record track
              , layerConfig :: Record layer }
              -> a)

class ApplyLayerDef
  (browser :: # Type)
  (track :: # Type)
  (layer :: # Type)
  (totalConfig :: # Type)
  (trackName :: Symbol)
  (layerName :: Symbol)
  a
  | trackName layerName totalConfig -> track layer where
    applyLayerDefImpl :: LayerDef browser track layer a
                      -> SProxy trackName
                      -> SProxy layerName
                      -> Record totalConfig
                      -> a

instance applyLayerDefInst ::
  ( IsSymbol trackName
  , IsSymbol layerName
  , GetBrowserConfig totalConfig browser
  , GetTrackConfig totalConfig track trackName
  , GetLayerConfig totalConfig layer trackName layerName
  ) => ApplyLayerDef browser track layer totalConfig trackName layerName a where
    applyLayerDefImpl (LayerDef f) trackName layerName total =
      let browserConfig = getBrowserConfigImpl total
          trackConfig = getTrackConfigImpl total trackName
          layerConfig = getLayerConfigImpl total trackName layerName
      in f { browserConfig, trackConfig, layerConfig }

applyLayerDef :: ∀ browser track layer trackName layerName config a.
                 IsSymbol trackName
              => IsSymbol layerName
              => ApplyLayerDef browser track layer config trackName layerName a
              => LayerDef browser track layer a
              -> SProxy trackName
              -> SProxy layerName
              -> Record config
              -> a
applyLayerDef = applyLayerDefImpl

-- | Class for checking if a RowList has a "conflict" with a
-- | given label and type. If the list lacks the label, or
-- | has the label with the same type, return False; if it
-- | has the label, but with a different type, return True.
class ConflictsWith
  (list :: RowList)
  (label :: Symbol)
  (t :: Type)
  (result :: Boolean)
  | list label t -> result

-- no conflict base case
instance conflictsWithNil ::
  ConflictsWith Nil label t False

-- same label and type, no conflict, recurse
instance conflictsWithCons1 ::
  ( ConflictsWith tail label t tailResult
  ) => ConflictsWith (Cons label  t  tail) label t tailResult

-- found conflict base case
else instance conflictsWithCons3 ::
  ConflictsWith (Cons label  t' tail) label t True

-- different label, same or different type, recurse
else instance conflictsWithCons2 ::
  ( ConflictsWith tail label t tailResult
  ) =>  ConflictsWith (Cons label' t' tail) label t tailResult

hasConflict :: ∀ row list l a .
                 RowToList row list
              => IsSymbol l
              => ConflictsWith list l a True
              => RProxy row
              -> SProxy l
              -> Proxy a
              -> Unit
hasConflict _ _ _ = unit

noConflict :: ∀ row list l a .
                 RowToList row list
              => IsSymbol l
              => ConflictsWith list l a False
              => RProxy row
              -> SProxy l
              -> Proxy a
              -> Unit
noConflict _ _ _ = unit

-- | Returns True if there are duplicates of any label with different types
class ConflictingList
  (list :: RowList)
  (result :: Boolean)
  | list -> result

instance conflictingListNil :: ConflictingList Nil False

instance conflictingListCons ::
  ( ConflictsWith tail label t conflicts
  , ConflictingList tail tailResult
  , Boolean.Or conflicts tailResult result
  ) => ConflictingList (Cons label t tail) result

doesConflict :: ∀ row list.
                RowToList row list
             => ConflictingList list True
             => RProxy row
             -> Unit
doesConflict _ = unit

class ConflictingRow
  (row :: # Type)
  (result :: Boolean)
  | row -> result

instance conflictingRow ::
  ( RowToList row list
  , ConflictingList list result
  ) => ConflictingRow row result

class UnionConflict (fail :: Boolean)

instance unionConflictFail ::
  ( Fail (Text "Tried to take union of conflicting rows")
  ) => UnionConflict True

instance unionConflictSuccess ::
  UnionConflict False

-- | Takes the union of two rows, except it errors if there are
-- | overlapping labels of different types, and it removes the
-- | redundant entries.
class SafeUnion
  (left :: # Type)
  (right :: # Type)
  (union :: # Type)
  | left right -> union

instance safeUnion ::
  ( UnionConflict conflicting
  , Row.Union left right union
  , RowToList union list
  , ConflictingList list conflicting
  , Row.Nub union nubbed
  ) => SafeUnion left right nubbed

rowUnion :: ∀ left right union.
            SafeUnion left right union
         => RProxy left
         -> RProxy right
         -> RProxy union
         -> Unit
rowUnion _ _ _ = unit

check = rowUnion (RProxy :: _ (a :: Int, b :: String))
                 (RProxy :: _ (b :: String))
                 (RProxy :: _ _)

module Genetics.Browser.Track
       ( class TrackRecord
       , buildTrack
       , makeTrack
       , TrackConfigRecord
       , class TrackConfig
       , makeContainersImpl
       , makeContainers
       , class TrackData
       , fetchDataImpl
       , fetchData
       , class CombineFuns
       , combineFunsImpl
       , combineFuns
       ) where

import Prelude

import Data.Foldable (foldMap)
import Data.Maybe (Maybe)
import Data.Pair (Pair)
import Effect (Effect)
import Effect.Aff (Aff)
import Genetics.Browser.Canvas (TrackContainer, trackContainer, withLoadingIndicator)
import Genetics.Browser.Coordinates (CoordSysView)
import Genetics.Browser.Layer (TrackPadding)
import Genetics.Browser.Types (Point)
import Prim.Boolean (False, True, kind Boolean)
import Prim.Row as Row
import Prim.RowList (class RowToList, Cons, Nil, kind RowList)
import Record (delete, get, insert)
import Type.Data.Boolean as Boolean
import Type.Data.Symbol as Symbol
import Type.Prelude (class IsSymbol, class TypeEquals, Proxy(..), RLProxy(..), RProxy(..), SProxy(..), from)
import Unsafe.Coerce (unsafeCoerce)

type TrackInterface a =
  { render   :: Pair Number -> CoordSysView -> Aff Unit
  , hotspots :: Aff (Number -> Point -> Array a) }

class TrackRecord
      (trackList :: RowList)
      (trackRow :: # Type)
      a
      | trackList -> trackRow
      , trackList -> a where
  buildTrack :: RLProxy trackList
             -> Record trackRow
             -> TrackContainer
             -> Aff { render   :: Pair Number -> CoordSysView -> Aff Unit
                    , hotspots :: Aff (Number -> Point -> Array a) }

instance trackRecordRender ::
  ( IsSymbol  name
  , Row.Lacks name trackRow'
  , Row.Cons  name (Pair Number -> CoordSysView -> Aff Unit) trackRow' trackRow
  , TrackRecord trackTail trackRow' a
  ) => TrackRecord (Cons name (Pair Number -> CoordSysView -> Aff Unit) trackTail) trackRow a where
  buildTrack _ r tcont = do

    let name = SProxy :: SProxy name

    rest <- buildTrack (RLProxy :: RLProxy trackTail)
                       (delete name r) tcont

    let rLayer p c = (get name r) p c

    pure { render:   rLayer <> rest.render
         , hotspots: rest.hotspots }

instance trackRecordUI ::
  ( IsSymbol  name
  , Row.Lacks name trackRow'
  , Row.Cons  name (Aff Unit) trackRow' trackRow
  , TrackRecord trackTail trackRow' a
  ) => TrackRecord (Cons name (Aff Unit) trackTail) trackRow a where
  buildTrack _ r tcont = do

    let name = SProxy :: SProxy name

    rest <- buildTrack (RLProxy :: RLProxy trackTail)
                       (delete name r) tcont

    let rLayer _ _ = (get name r)

    pure { render:   rLayer <> rest.render
         , hotspots: rest.hotspots }

instance trackRecordHotspots ::
  ( IsSymbol  name
  , Row.Lacks name trackRow'
  , Row.Cons  name (Aff (Number -> pt -> Array a)) trackRow' trackRow
  , TypeEquals pt Point
  , TrackRecord trackTail trackRow' a
  ) => TrackRecord (Cons name (Aff (Number -> pt -> Array a)) trackTail) trackRow a where
  buildTrack _ r tcont = do

    let name = SProxy :: SProxy name

    rest <- buildTrack (RLProxy :: RLProxy trackTail)
                       (delete name r) tcont

    let hotspots = ado
          h  <- get name r
          h' <- rest.hotspots
          in \rad p -> h rad (from p) <> h' rad p

    pure { render: rest.render, hotspots }

instance trackRecordNil ::
  ( TypeEquals (Record trackRow) {}
  ) => TrackRecord Nil trackRow a where
  buildTrack _ _ _ = mempty

makeTrack :: ∀ row list a.
             RowToList row list
          => TrackRecord list row a
          => Record row
          -> TrackContainer
          -> Aff (TrackInterface a)
makeTrack r c = buildTrack (RLProxy :: RLProxy list) r c

type TrackConfigRecord r =
  { trackHeight :: Number
  , padding :: TrackPadding | r }

class TrackConfig
  (confList :: RowList)
  (confRow  :: # Type)
  (trackRow :: # Type)
  | confList -> confRow trackRow
  where
  makeContainersImpl :: RLProxy confList
                     -> Number
                     -> Record confRow
                     -> Effect (Record trackRow)

instance trackConfigNil ::
  ( TypeEquals (Record tr) {}
  ) => TrackConfig Nil cr tr where
  makeContainersImpl _ _ _ = pure $ from {}

instance trackConfigCons ::
  ( IsSymbol name
  , TrackConfig tail confRow' trackRow'
  , Row.Cons name c confRow' confRow
  , Row.Lacks name confRow'
  , Row.Cons name TrackContainer trackRow' trackRow
  , Row.Lacks name trackRow'
  , TypeEquals (TrackConfigRecord we) c
  ) => TrackConfig (Cons name c tail) confRow trackRow where
  makeContainersImpl _ width r = do
    let n = SProxy :: SProxy name

        c :: TrackConfigRecord we
        c = from $ get n r

    cont <- trackContainer
              {width, height: c.trackHeight}
              c.padding
              (Symbol.reflectSymbol n)

    rest <- makeContainersImpl
              (RLProxy :: RLProxy tail)
              width
              (delete n $ from r)

    pure $ insert n cont rest

makeContainers :: ∀ cl cr tr.
                  RowToList cr cl
               => TrackConfig cl cr tr
               => Number
               -> Record cr
               -> Effect (Record tr)
makeContainers = makeContainersImpl (RLProxy :: RLProxy cl)

class TrackData
      (fetcherList :: RowList)
      (fetcherRow :: # Type)
      (urlRow :: # Type)
      (dataRow :: # Type)
      | fetcherList -> fetcherRow
      , fetcherList -> urlRow
      , fetcherList -> dataRow where
  fetchDataImpl :: RLProxy fetcherList
            -> Record fetcherRow
            -> Record urlRow
            -> Aff (Record dataRow)

instance trackDataCons ::
  ( IsSymbol  name
  , Row.Lacks name fetcherRow'
  , Row.Cons  name (String -> Aff x) fetcherRow' fetcherRow
  , Monoid x
  , Row.Cons  name (Maybe String) urlRow' urlRow
  , Row.Lacks name dataRow'
  , Row.Cons  name x dataRow' dataRow
  , TrackData fetcherTail fetcherRow' urlRow dataRow'
  ) => TrackData (Cons name (String -> Aff x) fetcherTail)
                 fetcherRow
                 urlRow
                 dataRow where
  fetchDataImpl _ fetchers urls = do
    let name = SProxy :: _ name

    rest <- fetchDataImpl (RLProxy :: _ fetcherTail)
                          (delete name fetchers)
                          urls

    dataset <- foldMap (get name fetchers) (get name urls)

    pure $ insert name dataset rest

instance trackDataNil ::
  ( TypeEquals (Record dataRow) {}
  ) => TrackData Nil () urlRow dataRow where
  fetchDataImpl _ _ _ = pure $ from {}

-- | `fetchData` puts a loading indicator in the provided TrackContainer,
-- | fetches the data in the provided `urlRow` record, and parses it
-- | using the parsers in the provided `parserRow` record.
fetchData :: ∀ fetcherRow fetcherList urlRow urlList dataRow.
             RowToList fetcherRow fetcherList
          => RowToList urlRow urlList
          => TrackData fetcherList fetcherRow urlRow dataRow
          => TrackContainer
          -> Record fetcherRow
          -> Record urlRow
          -> Aff (Record dataRow)
fetchData tc fs urls = withLoadingIndicator tc
                       $ fetchDataImpl (RLProxy :: _ fetcherList)
                                       fs
                                       urls

-- | Combine a record of functions from records,
-- | into a function from a record of their union,
-- | to a record of their outputs.
-- | E.g. `{f :: Record r1 -> a, g :: Record r2 -> b}`
-- | into `Record (r1 + r2) -> { f :: a, g :: b }`
class CombineFuns
  (funsList :: RowList)
  (funsRow :: # Type)
  (argRow :: # Type)
  (outRow :: # Type)
  | funsList -> funsRow
  , funsList -> argRow
  , funsList -> outRow where
  combineFunsImpl :: RLProxy funsList
              -> Record funsRow
              -> Record argRow
              -> Record outRow

instance combineFunCons ::
  ( IsSymbol  name
  , Row.Lacks name funsRow'
  , Row.Cons  name (Record r -> a) funsRow' funsRow
  , Row.Union argRow' r argRowUnion
  , Row.Nub   argRowUnion argRowNubbed
  , Row.Lacks name outRow'
  , Row.Cons  name a outRow' outRow
  , CombineFuns funsTail funsRow' argRow' outRow'
  ) => CombineFuns (Cons name (Record r -> a) funsTail)
                  funsRow
                  argRowNubbed
                  outRow where
  combineFunsImpl _ funs args =
    let name = SProxy :: _ name

        thoseArgs :: Record argRow'
        thoseArgs = unsafeCoerce args

        theseArgs :: Record r
        theseArgs = unsafeCoerce args

        rest = combineFunsImpl (RLProxy :: _ funsTail)
                               (delete name funs)
                               thoseArgs
        fn = (get name funs)

    in (insert name (fn theseArgs) rest)

instance combineFunNil ::
  ( TypeEquals (Record outRow) {}
  ) => CombineFuns Nil () () outRow where
  combineFunsImpl _ _ _ = from {}

-- | Note! this isn't actually type safe yet.
-- | If two functions use arguments with the same label
-- | but different types, things break...
combineFuns :: ∀ funsList funsRow argRow outRow.
               RowToList funsRow funsList
            => CombineFuns funsList funsRow argRow outRow
            => Record funsRow
            -> Record argRow
            -> Record outRow
combineFuns funs args = combineFunsImpl (RLProxy :: _ funsList) funs args

class BuildLayers
  (layers :: # Type)
  (output :: # Type)
  | layers -> output

class GetBrowserConfig
  (totalConfig :: # Type)
  (browser :: # Type)
  | totalConfig -> browser where
    getBrowserConfigImpl :: Record totalConfig
                         -> Record browser

instance getBrowserConfig ::
  ( IsSymbol sBrowser
  , TypeEquals (SProxy sBrowser) (SProxy "browser")
  , IsSymbol sLayers
  , TypeEquals (SProxy sLayers) (SProxy "layers")

  , Row.Cons sBrowser (Record browser') totalConfig' totalConfig
  , Row.Lacks sBrowser totalConfig'

  , Row.Cons sLayers layers browser browser'
  , Row.Lacks sLayers browser
  ) => GetBrowserConfig totalConfig browser where
  getBrowserConfigImpl total =
    let browser' :: Record browser'
        browser' = get (from (SProxy :: _ "browser")) total
    in delete (from (SProxy :: _ "layers")) browser'

class GetTrackConfig
  (totalConfig :: # Type)
  (track :: # Type)
  (trackName :: Symbol)
  | totalConfig trackName -> track where
    getTrackConfigImpl :: Record totalConfig
                       -> SProxy trackName
                       -> Record track

instance getTrackConfig ::
  ( IsSymbol sTracks
  , TypeEquals (SProxy sTracks) (SProxy "tracks")
  , IsSymbol sLayers
  , TypeEquals (SProxy sLayers) (SProxy "layers")
  , IsSymbol trackName

  , Row.Cons sTracks (Record tracks) totalConfig' totalConfig
  , Row.Lacks sTracks totalConfig'

  , Row.Cons trackName (Record thisTrack') tracks' tracks
  , Row.Lacks trackName tracks'

  , Row.Cons sLayers layers thisTrack thisTrack'
  , Row.Lacks sLayers thisTrack

  ) => GetTrackConfig totalConfig thisTrack trackName where
    getTrackConfigImpl total _ =
      let tracks' :: Record tracks
          tracks' = get (from (SProxy :: _ "tracks")) total

          thisTrack :: Record thisTrack'
          thisTrack = get (from (SProxy :: _ trackName)) tracks'

      in delete (from (SProxy :: _ "layers")) thisTrack

class GetLayerConfig
  (totalConfig :: # Type)
  (layer :: # Type)
  (trackName :: Symbol)
  (layerName :: Symbol)
  | totalConfig trackName layerName -> layer where
    getLayerConfigImpl :: Record totalConfig
                       -> SProxy trackName
                       -> SProxy layerName
                       -> Record layer

instance getLayerConfig ::
  ( IsSymbol sTracks
  , TypeEquals (SProxy sTracks) (SProxy "tracks")
  , IsSymbol sLayers
  , TypeEquals (SProxy sLayers) (SProxy "layers")
  , IsSymbol trackName
  , IsSymbol layerName

  , Row.Cons sTracks (Record tracks) totalConfig' totalConfig
  , Row.Lacks sTracks totalConfig'

  , Row.Cons trackName (Record thisTrack) tracks' tracks
  , Row.Lacks trackName tracks'

  , Row.Cons sLayers (Record layers) thisTrack' thisTrack
  , Row.Lacks sLayers thisTrack

  , Row.Cons layerName (Record thisLayer) layers' layers
  , Row.Lacks layerName layers'
  ) => GetLayerConfig totalConfig thisLayer trackName layerName where
    getLayerConfigImpl total _ _ =
      let tracks' :: Record tracks
          tracks' = get (from (SProxy :: _ "tracks")) total

          thisTrack :: Record thisTrack
          thisTrack = get (from (SProxy :: _ trackName)) tracks'

          layers :: Record layers
          layers = get (from (SProxy :: _ "layers")) thisTrack

      in get (from (SProxy :: _ layerName)) layers

newtype LayerDef browser track layer a
  = LayerDef ({ browserConfig :: Record browser
              , trackConfig :: Record track
              , layerConfig :: Record layer }
              -> a)

class ApplyLayerDef
  (browser :: # Type)
  (track :: # Type)
  (layer :: # Type)
  (totalConfig :: # Type)
  (trackName :: Symbol)
  (layerName :: Symbol)
  a
  | trackName layerName totalConfig -> track layer where
    applyLayerDefImpl :: LayerDef browser track layer a
                      -> SProxy trackName
                      -> SProxy layerName
                      -> Record totalConfig
                      -> a

instance applyLayerDefInst ::
  ( IsSymbol trackName
  , IsSymbol layerName
  , GetBrowserConfig totalConfig browser
  , GetTrackConfig totalConfig track trackName
  , GetLayerConfig totalConfig layer trackName layerName
  ) => ApplyLayerDef browser track layer totalConfig trackName layerName a where
    applyLayerDefImpl (LayerDef f) trackName layerName total =
      let browserConfig = getBrowserConfigImpl total
          trackConfig = getTrackConfigImpl total trackName
          layerConfig = getLayerConfigImpl total trackName layerName
      in f { browserConfig, trackConfig, layerConfig }

applyLayerDef :: ∀ browser track layer trackName layerName config a.
                 IsSymbol trackName
              => IsSymbol layerName
              => ApplyLayerDef browser track layer config trackName layerName a
              => LayerDef browser track layer a
              -> SProxy trackName
              -> SProxy layerName
              -> Record config
              -> a
applyLayerDef = applyLayerDefImpl

-- | Class for checking if a RowList has a "conflict" with a
-- | given label and type. If the list lacks the label, or
-- | has the label with the same type, return False; if it
-- | has the label, but with a different type, return True.
class ConflictsWith
  (list :: RowList)
  (label :: Symbol)
  (t :: Type)
  (result :: Boolean)
  | list label t -> result

-- no conflict base case
instance conflictsWithNil ::
  ConflictsWith Nil label t False

-- same label and type, no conflict, recurse
instance conflictsWithCons1 ::
  ( ConflictsWith tail label t tailResult
  ) => ConflictsWith (Cons label  t  tail) label t tailResult

-- found conflict base case
else instance conflictsWithCons3 ::
  ConflictsWith (Cons label  t' tail) label t True

-- different label, same or different type, recurse
else instance conflictsWithCons2 ::
  ( ConflictsWith tail label t tailResult
  ) =>  ConflictsWith (Cons label' t' tail) label t tailResult

hasConflict :: ∀ row list l a .
                 RowToList row list
              => IsSymbol l
              => ConflictsWith list l a True
              => RProxy row
              -> SProxy l
              -> Proxy a
              -> Unit
hasConflict _ _ _ = unit

noConflict :: ∀ row list l a .
                 RowToList row list
              => IsSymbol l
              => ConflictsWith list l a False
              => RProxy row
              -> SProxy l
              -> Proxy a
              -> Unit
noConflict _ _ _ = unit

-- | Returns True if there are duplicates of any label with different types
class ConflictingList
  (list :: RowList)
  (result :: Boolean)
  | list -> result

instance conflictingListNil :: ConflictingList Nil False

instance conflictingListCons ::
  ( ConflictsWith tail label t conflicts
  , ConflictingList tail tailResult
  , Boolean.Or conflicts tailResult result
  ) => ConflictingList (Cons label t tail) result

doesConflict :: ∀ row list.
                RowToList row list
             => ConflictingList list True
             => RProxy row
             -> Unit
doesConflict _ = unit