module MagicHaskeller.LibExcelStaged where
import MagicHaskeller
import Data.List
import Data.Char

default (Int, Integer, Double)

-- gcd in the latest library is total, but with older versions gcd 0 0 causes an error. 
totalGCD x y =  gcd' (abs x) (abs y)
  where gcd' a 0  =  a
        gcd' a b  =  gcd' b (a `rem` b)




curry2 = curry
curry3 :: ((a,b,c) -> d) -> a->b->c->d
curry3 f x y z = f(x,y,z)
curry4 :: ((a,b,c,d) -> e) -> a->b->c->d->e
curry4 f w x y z = f(w,x,y,z)
curry5 :: ((a,b,c,d,e) -> f) -> a->b->c->d->e->f
curry5 f v w x y z = f(v,w,x,y,z)
curry6 :: ((a,b,c,d,e,f) -> g) -> a->b->c->d->e->f->g
curry6 f u v w x y z = f(u,v,w,x,y,z)

{-
The Policy:
1. During synthesis, monomorphic types including Int and Double must be used by mkTrie &c.
2. fromIntegral and floor are available when synthesizing, but they are removed by ppExcel.
3. Because of 2., functions must be defined polymorphically here, or the generation of input-output examples by the CGI would cause type mismatch.
-}

iF :: (Bool, a, a) -> a
iF (True,  t, f) = t
iF (False, t, f) = f
upper = map toUpper
lower = map toLower
{- This definition unnecessarily trims the spaces.
proper = unwords . map proper' . words
proper' ""     = ""
proper' (h:ts) = toUpper h : map toLower ts
-}
-- I think the following definition is enough. PROPER capitalizes letters even after a hyphen or an apostrophe.
proper ""     = ""
proper (c:cs) | isAlpha c = toUpper c : case span isAlpha cs of (ts, ds) -> map toLower ts ++ proper ds
              | otherwise = c : proper cs

right, left :: ([b], Int) -> [b]
left1  = take 1
right1 str = right (str, 1)
left  (b, a)    = take a b
right (b, a)    = reverse (take a (reverse b))
dropLeft b a    = right(b, len(b) - a)
mid   (c, a, b) = take b (drop (a - 1) c)
len :: Num a => String -> a
len = fromIntegral . length
concatenate (a, b) = a ++ b
concatenatE (a,b,c) = a++b++c
concatenaTE (a,b,c,d) = a++b++c++d
concatenATE (a,b,c,d,e) = a++b++c++d++e
concateNATE (a,b,c,d,e,f) = a++b++c++d++e++f


{-
max = maximum
min= minimum
average= \a -> Prelude.sum a / fromIntegral (length a)
count= \a -> length (filter (/= 0) a)
sumif ms = Prelude.sum[x|Just x <- ms]
-}
cEILING, fLOOR, mround :: (Double, Double) -> Double
cEILING (_, 0) = 0
cEILING (a, b) = fromIntegral (Prelude.ceiling (a / b))*b
mround  (_, 0) = 0
mround  (a, b) = fromIntegral (Prelude.round   (a / b))*b
-- http://office.microsoft.com/en-us/excel-help/mround-HP005209185.aspx?CTT=5&origin=HP005204211

-- As for FLOOR, FLOOR(0,0) is 0, but FLOOR(x,0) is #DIV/0 for other x's. Also, if the second argument is negative, the result is $NUM.
-- Thus, we should prepare something different, defining  \a b -> IF(b > 0, FLOOR(a,b), 0).
-- The postprocessor expands it to FLOOR(a,b) if b is known to be positive.
fLOOR0 a b | b <= 0    = 0
           | otherwise = fromIntegral (Prelude.floor   (a / b))*b
 
-- We need fLOOR in order to generate I/O examples. This definition is not exact, but it alerts anyway if its second argument is not positive.
fLOOR (0, 0) = 0 
fLOOR (a, b) | b <= 0    = 0/0
             | otherwise = fLOOR0 a b

-- これらの第２引数は切り捨てで整数にされるみたい。なので、**ではなく^^を用いなければならない。
rOUND, roundup, rounddown :: (Double, Int) -> Double
rOUND (a, b) = mround (a, 0.1 ^^ b)
roundup (a, b) | a > 0     = cEILING (a, 0.1 ^^ b)
               | otherwise = fLOOR0 a (0.1 ^^ b)
rounddown (a, b) | a < 0     = cEILING (a, 0.1 ^^ b)
                 | otherwise = fLOOR0 a (0.1 ^^ b)

trim = unwords . words
fIND :: (Num b) => (String, String, Int) -> Maybe b
fIND (pat, xs, pos) = fmap (fromIntegral . fst) $ Data.List.find (isPrefixOf pat . snd) $ zip [1..] $ drop (pos-1) $ tails xs
ifERROR :: (Maybe a, a) -> a
ifERROR (mb, x) = maybe x id mb
aND (a, b) = a && b
oR  (a, b) = a || b
sign :: Num a => a -> a
sign = signum
power (a,b) | isNaN result || isInfinite result = Nothing 
            | otherwise                         = Just result
  where result = a ** b
sQRT x | x < 0     = Nothing
       | otherwise = Just $ sqrt x
lOG(a,b) | a<=0 || b<=0 = Nothing
         | otherwise    = Just $ logBase b a
ln a | a <= 0    = Nothing
     | otherwise = Just $ Prelude.log a
pI () = pi
aTAN2 (x,y) = atan2 y x

fact n | n < 0 = Nothing
       | otherwise = Just $ product [1..n]
combin (n,r) | (signum n + 1) * (signum r + 1) * (signum (r-n) + 1) == 0 = Nothing
             | otherwise = Just $ product [n-r+1 .. n] `div` product [1..r]

mOD    :: (Int, Int) -> Maybe Int
mOD(_,0) = Nothing
mOD(m,n) = Just $ m `mod` n
degrees = ((180/pi)*)
radians = ((pi/180)*)


gCD (m, n) = totalGCD (truncate m) (truncate n)

findIx c xs n = finD(char(7), sUBSTITUTE(concatenate(c,xs), c, char(7), 1+abs(n)))-1
finD(c, xs) = maybe undefined id $ fIND(c, xs, 1)
char = (:"") . chr


sUBsTITUTE :: (String, String, String) -> String
sUBsTITUTE(ts, "", _) = ts -- 実際やってみたらこうだった．
sUBsTITUTE([], _,  _) = []
sUBsTITUTE(text@(t:ts), old, new) = case old `stripPrefix` text of Nothing   -> t   :  sUBsTITUTE(ts,   old, new)
                                                                   Just rest -> new ++ sUBsTITUTE(rest, old, new)

sUBSTITUTE :: (String, String, String, Int) -> String
sUBSTITUTE(text, old, new, num) | num <= 0  = error "#NUM"
                                | otherwise = if null old then text
                                                          else sUB text old new num
sUB ""          _   _   _ = ""
sUB text@(t:ts) old new n = case old `stripPrefix` text of Nothing               -> t : sUB ts old new n
                                                           Just rest | n<=1      -> new ++ rest
                                                                     | otherwise -> old ++ sUB rest old new (n-1)

sUBST4 :: String -> String -> String -> Int -> String
sUBST4 text old new num = sUBSTITUTE(text, old, new, 1+abs(num))

countStr :: Num a => String -> String -> a
countStr x ""  = 0
countStr x str = fromIntegral $ (length(x)-length(sUBsTITUTE(x,str,""))) `div` length (str)
$(mkCurriedDecls "'2" [|curry2|] [|(left,right,concatenate,cEILING,mround,rOUND,roundup,rounddown,ifERROR,aND,oR,power,lOG,aTAN2,combin,mOD,gCD)|])
{- The above should generate:
left'2  = curry2 left
right'2 = curry2 right
...
-}

$(mkCurriedDecls "'3" [|curry3|] [|(iF,mid,fIND,sUBsTITUTE,concatenatE)|])
{- again,
iF'3    = curry3 iF
mid'3   = curry3 mid
...
-}

$(mkCurriedDecls "'4" [|curry4|] [|concatenaTE|])

$(mkCurriedDecls "'5" [|curry5|] [|concatenATE|])

$(mkCurriedDecls "'6" [|curry6|] [|concateNATE|])