module Language.Fay.Stdlib
(($)
,($!)
,(!!)
,(++)
,(.)
,(=<<)
,(**)
,(^^)
,(^)
,Either(..)
,Ordering(..)
,abs
,acos
,acosh
,all
,and
,any
,asin
,asinh
,asTypeOf
,atan
,atanh
,break
,ceiling
,compare
,concat
,concatMap
,const
,cos
,cosh
,curry
,cycle
,div
,divMod
,drop
,dropWhile
,either
,elem
,enumFrom
,enumFromThen
,enumFromThenTo
,enumFromTo
,error
,even
,exp
,filter
,find
,flip
,floor
,foldl
,foldl1
,foldr
,foldr1
,forM_
,fromInteger
,fromIntegral
,fromRational
,fst
,gcd
,head
,id
,init
,insertBy
,intercalate
,intersperse
,iterate
,last
,lcm
,length
,lines
,log
,logBase
,lookup
,map
,mapM_
,max
,maximum
,maybe
,min
,minimum
,mod
,negate
,not
,notElem
,nub
,null
,odd
,or
,otherwise
,pi
,pred
,prependToAll
,print
,product
,properFraction
,putStrLn
,quot
,quotRem
,recip
,rem
,repeat
,replicate
,reverse
,round
,scanl
,scanl1
,scanr
,scanr1
,seq
,sequence
,sequence_
,show
,signum
,sin
,sinh
,snd
,sort
,sortBy
,span
,splitAt
,sqrt
,subtract
,succ
,sum
,tail
,take
,takeWhile
,tan
,tanh
,truncate
,uncurry
,undefined
,unlines
,until
,unwords
,unzip
,unzip3
,when
,words
,zip
,zip3
,zipWith
,zipWith3)
where
import Language.Fay.FFI
import Prelude (Bool (..), Double, Eq (..), Fractional,
Fractional ((/)), Int, Integer, Maybe (..),
Monad (..), Num ((+), (), (*)),
Ord ((>), (<)), Rational, Show, String, seq,
(&&), (||))
error :: String -> a
error str = case error' str of 0 -> error str ; _ -> error str
error' :: String -> Int
error' = ffi "(function() { throw %1 })()"
undefined :: a
undefined = error "Prelude.undefined"
show :: (Foreign a, Show a) => Automatic a -> String
show = ffi "JSON.stringify(%1)"
data Either a b = Left a | Right b
either :: (a -> c) -> (b -> c) -> Either a b -> c
either f _ (Left a) = f a
either _ g (Right b) = g b
fromInteger :: a -> a
fromInteger x = x
fromRational :: a -> a
fromRational x = x
negate :: Num a => a -> a
negate x = (x)
abs :: (Num a, Ord a) => a -> a
abs x = if x < 0 then negate x else x
signum :: (Num a, Ord a) => a -> a
signum x = if x > 0 then 1 else if x == 0 then 0 else 1
pi :: Double
pi = ffi "Math.PI"
exp :: Double -> Double
exp = ffi "Math.exp(%1)"
sqrt :: Double -> Double
sqrt = ffi "Math.sqrt(%1)"
log :: Double -> Double
log = ffi "Math.log(%1)"
(**) :: Double -> Double -> Double
(**) = unsafePow
infixr 8 **
(^^) :: Double -> Int -> Double
(^^) = unsafePow
infixr 8 ^^
unsafePow :: (Foreign a, Num a, Foreign b, Num b) => a -> b -> a
unsafePow = ffi "Math.pow(%1,%2)"
(^) :: Num a => a -> Int -> a
a ^ b | b < 0 = error "(^): negative exponent"
| b == 0 = 1
| even b = let x = a ^ (b `quot` 2) in x * x
a ^ b = a * a ^ (b 1)
infixr 8 ^
logBase :: Double -> Double -> Double
logBase b x = log x / log b
sin :: Double -> Double
sin = ffi "Math.sin(%1)"
tan :: Double -> Double
tan = ffi "Math.tan(%1)"
cos :: Double -> Double
cos = ffi "Math.cos(%1)"
asin :: Double -> Double
asin = ffi "Math.asin(%1)"
atan :: Double -> Double
atan = ffi "Math.atan(%1)"
acos :: Double -> Double
acos = ffi "Math.acos(%1)"
sinh :: Double -> Double
sinh x = (exp x exp (x)) / 2
tanh :: Double -> Double
tanh x = let a = exp x ; b = exp (x) in (a b) / (a + b)
cosh :: Double -> Double
cosh x = (exp x + exp (x)) / 2
asinh :: Double -> Double
asinh x = log (x + sqrt(x**2 + 1))
atanh :: Double -> Double
atanh x = log ((1 + x) / (1 x)) / 2
acosh :: Double -> Double
acosh x = log (x + sqrt (x**2 1))
properFraction :: Double -> (Int, Double)
properFraction x = let a = truncate x in (a, x fromIntegral a)
truncate :: Double -> Int
truncate x = if x < 0 then ceiling x else floor x
round :: Double -> Int
round = ffi "Math.round(%1)"
ceiling :: Double -> Int
ceiling = ffi "Math.ceil(%1)"
floor :: Double -> Int
floor = ffi "Math.floor(%1)"
subtract :: Num a => a -> a -> a
subtract = flip ()
even :: Int -> Bool
even x = x `rem` 2 == 0
odd :: Int -> Bool
odd x = not (even x)
gcd :: Int -> Int -> Int
gcd a b = go (abs a) (abs b)
where go x 0 = x
go x y = go y (x `rem` y)
lcm :: Int -> Int -> Int
lcm _ 0 = 0
lcm 0 _ = 0
lcm a b = abs ((a `quot` (gcd a b)) * b)
curry :: ((a, b) -> c) -> a -> b -> c
curry f x y = f (x, y)
uncurry :: (a -> b -> c) -> (a, b) -> c
uncurry f p = case p of (x, y) -> f x y
snd :: (t, t1) -> t1
snd (_,x) = x
fst :: (t, t1) -> t
fst (x,_) = x
find :: (a -> Bool) -> [a] -> Maybe a
find p (x:xs) = if p x then Just x else find p xs
find _ [] = Nothing
filter :: (a -> Bool) -> [a] -> [a]
filter p (x:xs) = if p x then x : filter p xs else filter p xs
filter _ [] = []
not :: Bool -> Bool
not p = if p then False else True
null :: [t] -> Bool
null [] = True
null _ = False
map :: (a -> b) -> [a] -> [b]
map _ [] = []
map f (x:xs) = f x : map f xs
nub :: Eq a => [a] -> [a]
nub ls = nub' ls []
nub' :: Eq a => [a] -> [a] -> [a]
nub' [] _ = []
nub' (x:xs) ls =
if elem x ls
then nub' xs ls
else x : nub' xs (x : ls)
elem :: Eq a => a -> [a] -> Bool
elem x (y:ys) = x == y || elem x ys
elem _ [] = False
notElem :: Eq a => a -> [a] -> Bool
notElem x ys = not (elem x ys)
data Ordering = GT | LT | EQ
sort :: Ord a => [a] -> [a]
sort = sortBy compare
compare :: Ord a => a -> a -> Ordering
compare x y =
if x > y
then GT
else if x < y
then LT
else EQ
sortBy :: (t -> t -> Ordering) -> [t] -> [t]
sortBy cmp = foldr (insertBy cmp) []
insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy _ x [] = [x]
insertBy cmp x ys =
case ys of
[] -> [x]
y:ys' ->
case cmp x y of
GT -> y : insertBy cmp x ys'
_ -> x : ys
when :: Monad m => Bool -> m a -> m ()
when p m = if p then m >> return () else return ()
succ :: Num a => a -> a
succ x = x + 1
pred :: Num a => a -> a
pred x = x 1
enumFrom :: Num a => a -> [a]
enumFrom i = i : enumFrom (i + 1)
enumFromTo :: (Ord t, Num t) => t -> t -> [t]
enumFromTo i n =
if i > n then [] else i : enumFromTo (i + 1) n
enumFromBy :: (Num t) => t -> t -> [t]
enumFromBy fr by = fr : enumFromBy (fr + by) by
enumFromThen :: (Num t) => t -> t -> [t]
enumFromThen fr th = enumFromBy fr (th fr)
enumFromByTo :: (Ord t, Num t) => t -> t -> t -> [t]
enumFromByTo fr by to = if by < 0 then neg fr else pos fr
where neg x = if x < to then [] else x : neg (x + by)
pos x = if x > to then [] else x : pos (x + by)
enumFromThenTo :: (Ord t, Num t) => t -> t -> t -> [t]
enumFromThenTo fr th to = enumFromByTo fr (th fr) to
zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
zipWith _ _ _ = []
zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 f (a:as) (b:bs) (c:cs) = f a b c : zipWith3 f as bs cs
zipWith3 _ _ _ _ = []
zip :: [a] -> [b] -> [(a,b)]
zip (a:as) (b:bs) = (a,b) : zip as bs
zip _ _ = []
zip3 :: [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs
zip3 _ _ _ = []
unzip :: [(a, b)] -> ([a], [b])
unzip ((x,y):ps) = case unzip ps of (xs,ys) -> (x:xs, y:ys)
unzip [] = ([], [])
unzip3 :: [(a, b, c)] -> ([a], [b], [c])
unzip3 ((x,y,z):ps) = case unzip3 ps of (xs,ys,zs) -> (x:xs, y:ys, z:zs)
unzip3 [] = ([], [], [])
lines :: String -> [String]
lines [] = []
lines s = case break isLineBreak s of (a, []) -> [a]
(a, _:cs) -> a : lines cs
where isLineBreak c = c == '\r' || c == '\n'
unlines :: [String] -> String
unlines = intercalate "\n"
words :: String -> [String]
words str = words' (dropWhile isSpace str)
where words' [] = []
words' s = case break isSpace s of (a,b) -> a : words b
isSpace c = c `elem` " \t\r\n\f\v"
unwords :: [String] -> String
unwords = intercalate " "
flip :: (t1 -> t2 -> t) -> t2 -> t1 -> t
flip f x y = f y x
maybe :: t -> (t1 -> t) -> Maybe t1 -> t
maybe m _ Nothing = m
maybe _ f (Just x) = f x
(.) :: (t1 -> t) -> (t2 -> t1) -> t2 -> t
(f . g) x = f (g x)
infixr 9 .
(++) :: [a] -> [a] -> [a]
x ++ y = conc x y
infixr 5 ++
($) :: (t1 -> t) -> t1 -> t
f $ x = f x
infixr 0 $
conc :: [a] -> [a] -> [a]
conc (x:xs) ys = x : conc xs ys
conc [] ys = ys
concat :: [[a]] -> [a]
concat = foldr conc []
concatMap :: (a -> [b]) -> [a] -> [b]
concatMap f = foldr ((++) . f) []
foldr :: (t -> t1 -> t1) -> t1 -> [t] -> t1
foldr _ z [] = z
foldr f z (x:xs) = f x (foldr f z xs)
foldr1 :: (a -> a -> a) -> [a] -> a
foldr1 _ [x] = x
foldr1 f (x:xs) = f x (foldr1 f xs)
foldr1 _ [] = error "foldr1: empty list"
foldl :: (t1 -> t -> t1) -> t1 -> [t] -> t1
foldl _ z [] = z
foldl f z (x:xs) = foldl f (f z x) xs
foldl1 :: (a -> a -> a) -> [a] -> a
foldl1 f (x:xs) = foldl f x xs
foldl1 _ [] = error "foldl1: empty list"
and :: [Bool] -> Bool
and [] = True
and (x:xs) = x && and xs
or :: [Bool] -> Bool
or [] = False
or (x:xs) = x || or xs
any :: (a -> Bool) -> [a] -> Bool
any _ [] = False
any p (x:xs) = p x || any p xs
all :: (a -> Bool) -> [a] -> Bool
all _ [] = True
all p (x:xs) = p x && all p xs
maximum :: (Num a, Foreign a) => [a] -> a
maximum [] = error "maximum: empty list"
maximum xs = foldl1 max xs
minimum :: (Num a, Foreign a) => [a] -> a
minimum [] = error "minimum: empty list"
minimum xs = foldl1 min xs
product :: Num a => [a] -> a
product [] = error "product: empty list"
product xs = foldl (*) 1 xs
sum :: Num a => [a] -> a
sum [] = error "sum: empty list"
sum xs = foldl (+) 0 xs
scanl :: (a -> b -> a) -> a -> [b] -> [a]
scanl f z l = z : case l of [] -> []
(x:xs) -> scanl f (f z x) xs
scanl1 :: (a -> a -> a) -> [a] -> [a]
scanl1 _ [] = []
scanl1 f (x:xs) = scanl f x xs
scanr :: (a -> b -> b) -> b -> [a] -> [b]
scanr _ z [] = [z]
scanr f z (x:xs) = case scanr f z xs of (h:t) -> f x h : h : t
_ -> undefined
scanr1 :: (a -> a -> a) -> [a] -> [a]
scanr1 _ [] = []
scanr1 _ [x] = [x]
scanr1 f (x:xs) = case scanr1 f xs of (h:t) -> f x h : h : t
_ -> undefined
lookup :: Eq a1 => a1 -> [(a1, a)] -> Maybe a
lookup _key [] = Nothing
lookup key ((x,y):xys) =
if key == x
then Just y
else lookup key xys
intersperse :: a -> [a] -> [a]
intersperse _ [] = []
intersperse sep (x:xs) = x : prependToAll sep xs
prependToAll :: a -> [a] -> [a]
prependToAll _ [] = []
prependToAll sep (x:xs) = sep : x : prependToAll sep xs
intercalate :: [a] -> [[a]] -> [a]
intercalate xs xss = concat (intersperse xs xss)
forM_ :: Monad m => [t] -> (t -> m a) -> m ()
forM_ (x:xs) m = m x >> forM_ xs m
forM_ [] _ = return ()
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
mapM_ m (x:xs) = m x >> mapM_ m xs
mapM_ _ [] = return ()
const :: a -> b -> a
const a _ = a
length :: [a] -> Int
length xs = length' 0 xs
length' :: Int -> [a] -> Int
length' acc (_:xs) = length' (acc+1) xs
length' acc _ = acc
rem :: Int -> Int -> Int
rem x y = if y == 0 then error "Division by zero" else rem' x y
infixl 7 `rem`
rem' :: Int -> Int -> Int
rem' = ffi "%1 %% %2"
quot :: Int -> Int -> Int
quot x y = if y == 0 then error "Division by zero" else quot' x y
infixl 7 `quot`
quot' :: Int -> Int -> Int
quot' = ffi "~~(%1/%2)"
quotRem :: Int -> Int -> (Int, Int)
quotRem x y = (quot x y, rem x y)
div :: Int -> Int -> Int
div x y
| x > 0 && y < 0 = quot (x1) y 1
| x < 0 && y > 0 = quot (x+1) y 1
div x y = quot x y
infixl 7 `div`
mod :: Int -> Int -> Int
mod x y
| x > 0 && y < 0 = rem (x1) y + y + 1
| x < 0 && y > 0 = rem (x+1) y + y 1
mod x y = rem x y
infixl 7 `mod`
divMod :: Int -> Int -> (Int, Int)
divMod x y
| x > 0 && y < 0 = case (x1) `quotRem` y of (q,r) -> (q1, r+y+1)
| x < 0 && y > 1 = case (x+1) `quotRem` y of (q,r) -> (q1, r+y1)
divMod x y = quotRem x y
min :: (Num a, Foreign a) => a -> a -> a
min = ffi "Math.min(%1,%2)"
max :: (Num a, Foreign a) => a -> a -> a
max = ffi "Math.max(%1,%2)"
recip :: Double -> Double
recip x = 1 / x
fromIntegral :: Int -> Double
fromIntegral = ffi "%1"
otherwise :: Bool
otherwise = True
reverse :: [a] -> [a]
reverse (x:xs) = reverse xs ++ [x]
reverse [] = []
(=<<) :: Monad m => (a -> m b) -> m a -> m b
f =<< x = x >>= f
infixl 1 =<<
sequence :: (Monad m) => [m a] -> m [a]
sequence ms = foldr k (return []) ms
where
k m m' = do { x <- m; xs <- m'; return (x:xs) }
sequence_ :: Monad m => [m a] -> m ()
sequence_ [] = return ()
sequence_ (m:ms) = m >> sequence_ ms
id :: a -> a
id x = x
asTypeOf :: a -> a -> a
asTypeOf = const
until :: (a -> Bool) -> (a -> a) -> a -> a
until p f x = if p x then x else until p f (f x)
($!) :: (a -> b) -> a -> b
f $! x = x `seq` f x
infixr 0 $!
(!!) :: [a] -> Int -> a
a !! b = if b < 0 then error "(!!): negative index" else go a b
where go [] _ = error "(!!): index too large"
go (h:_) 0 = h
go (_:t) n = go t (n1)
infixl 9 !!
head :: [a] -> a
head [] = error "head: empty list"
head (h:_) = h
tail :: [a] -> [a]
tail [] = error "tail: empty list"
tail (_:t) = t
init :: [a] -> [a]
init [] = error "init: empty list"
init [a] = [a]
init (h:t) = h : init t
last :: [a] -> a
last [] = error "last: empty list"
last [a] = a
last (_:t) = last t
iterate :: (a -> a) -> a -> [a]
iterate f x = x : iterate f (f x)
repeat :: a -> [a]
repeat x = x : repeat x
replicate :: Int -> a -> [a]
replicate 0 _ = []
replicate n x = if n < 0 then error "replicate: negative length"
else x : replicate (n1) x
cycle :: [a] -> [a]
cycle [] = error "cycle: empty list"
cycle xs = xs' where xs' = xs ++ xs'
take :: Int -> [a] -> [a]
take 0 _ = []
take _ [] = []
take n (x:xs) = if n < 0 then error "take: negative length"
else x : take (n1) xs
drop :: Int -> [a] -> [a]
drop 0 xs = xs
drop _ [] = []
drop n (_:xs) = if n < 0 then error "drop: negative length"
else drop (n1) xs
splitAt :: Int -> [a] -> ([a], [a])
splitAt 0 xs = ([], xs)
splitAt _ [] = ([], [])
splitAt n (x:xs) = if n < 0 then error "splitAt: negative length"
else case splitAt (n1) xs of (a,b) -> (x:a, b)
takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile _ [] = []
takeWhile p (x:xs) = if p x then x : takeWhile p xs else []
dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile _ [] = []
dropWhile p (x:xs) = if p x then dropWhile p xs else x:xs
span :: (a -> Bool) -> [a] -> ([a], [a])
span _ [] = ([], [])
span p (x:xs) = if p x then case span p xs of (a,b) -> (x:a, b) else ([], x:xs)
break :: (a -> Bool) -> [a] -> ([a], [a])
break p = span (not . p)
print :: (Foreign a) => Automatic a -> Fay ()
print = ffi "(function(x) { if (console && console.log) console.log(x) })(%1)"
putStrLn :: String -> Fay ()
putStrLn = ffi "(function(x) { if (console && console.log) console.log(x) })(%1)"