{-|
Module      : Gargantext.Prelude
Description : Specific Prelude of the project
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}


{-# OPTIONS_GHC -fno-warn-orphans        #-}
{-# OPTIONS_GHC -fno-warn-type-defaults  #-}

module Gargantext.Prelude
  ( module Gargantext.Prelude
  , module Protolude
  , module GHC.Err.Located
  , module Text.Show
  , module Text.Read
  , module Data.Maybe
  , module Prelude
  , MonadBase(..)
  , Typeable
  , cs
  , headMay, lastMay, sortWith
  , round
  )
  where

import Control.Monad.Base (MonadBase(..))
import Data.Set (Set)
import GHC.Exts (sortWith)
import GHC.Err.Located (undefined)
import GHC.Real (round)
import Data.Map (Map, lookup)
import Data.Maybe (isJust, fromJust, maybe)
import Data.Monoid (Monoid, mempty)
import Data.Semigroup (Semigroup, (<>))
import Data.Text (Text)
import Data.Typeable (Typeable)
import Protolude ( Bool(True, False), Int, Int64, Double, Integer
                 , Fractional, Num, Maybe(Just,Nothing)
                 , Enum, Bounded, Float
                 , Floating, Char, IO
                 , Functor(..)
                 , pure, (>>=), (=<<), (<*>), (<$>), (<&>), (>>)
                 , head, flip
                 , Ord, Integral, Foldable, RealFrac, Monad, filter
                 , reverse, map, mapM, zip, drop, take, zipWith
                 , sum, fromIntegral, length, fmap, foldl, foldl'
                 , takeWhile, sqrt, identity
                 , abs, min, max, maximum, minimum, return, snd, truncate
                 , (+), (*), (/), (-), (.), ($), (&), (**), (^), (<), (>), log
                 , Eq, (==), (>=), (<=), (<>), (/=), xor
                 , (&&), (||), not, any, all
                 , concatMap
                 , fst, snd, toS
                 , elem, die, mod, div, const, either
                 , curry, uncurry, repeat
                 , otherwise, when
                 , IO()
                 , compare
                 , on
                 , panic
                 , seq
                 )

import Prelude (Enum, Bounded, minBound, maxBound, putStrLn)
-- TODO import functions optimized in Utils.Count
-- import Protolude hiding (head, last, all, any, sum, product, length)
-- import Gargantext.Utils.Count
import Data.Map.Strict (insertWith)
import Data.String.Conversions (cs)
import Safe (headMay, lastMay, initMay, tailMay)
import Text.Read (Read())
import Text.Show (Show(), show)
import qualified Control.Monad as M
import qualified Data.List     as L hiding (head, sum)
import qualified Data.Map      as M
import qualified Data.Set      as Set
import qualified Data.Vector   as V


printDebug :: (Show a, MonadBase IO m) => [Char] -> a -> m ()
printDebug msg x = liftBase . putStrLn $ msg <> " " <> show x
-- printDebug _ _ = pure ()


-- | splitEvery n == chunkAlong n n
splitEvery :: Int -> [a] -> [[a]]
splitEvery _ [] = []
splitEvery n xs =
  let (h,t) = L.splitAt n xs
  in  h : splitEvery n t

type Grain = Int
type Step  = Int

-- | Function to split a range into chunks
-- if   step == grain then linearity (splitEvery)
-- elif step < grain then overlapping
-- else dotted with holes
-- TODO FIX BUG if Steps*Grain /= length l
-- chunkAlong 10 10 [1..15] == [1..10]
-- BUG: what about the rest of (divMod 15 10)?
-- TODO: chunkAlongNoRest or chunkAlongWithRest
-- default behavior: NoRest

chunkAlong :: Eq a => Grain -> Step -> [a] -> [[a]]
chunkAlong a b l = case a >= length l of
  True  -> [l]
  False -> chunkAlong' a b l

chunkAlong' :: Eq a => Grain -> Step -> [a] -> [[a]]
chunkAlong' a b l = case a > 0 && b > 0 of
  True  -> chunkAlong'' a b l
  False -> panic "ChunkAlong: Parameters should be > 0 and Grain > Step"

chunkAlong'' :: Eq a => Int -> Int -> [a] -> [[a]]
chunkAlong'' a b l = filter (/= []) $ only (while dropAlong)
  where
    only      = map       (take a)
    while     = takeWhile (\x -> length x >= a)
    dropAlong = L.scanl   (\x _y -> drop b x) l ([1..] :: [Integer])

-- | Optimized version (Vector)
chunkAlongV :: Int -> Int -> V.Vector a -> V.Vector (V.Vector a)
chunkAlongV a b l = only (while  dropAlong)
  where
    only      = V.map       (V.take a)
    while     = V.takeWhile (\x -> V.length x >= a)
    dropAlong = V.scanl     (\x _y -> V.drop b x) l (V.fromList [1..])

-- | TODO Inverse of chunk ? unchunkAlong ?
-- unchunkAlong :: Int -> Int -> [[a]] -> [a]
-- unchunkAlong = undefined


-- splitAlong [2,3,4] ("helloworld" :: [Char]) == ["he", "llo", "worl", "d"]
splitAlong :: [Int] -> [Char] -> [[Char]]
splitAlong _ [] = [] -- No list? done
splitAlong [] xs = [xs] -- No place to split at? Return the remainder
splitAlong (x:xs) ys = take x ys : splitAlong xs (drop x ys)
-- take until our split spot, recurse with next split spot and list remainder

takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
takeWhileM _ [] = return []
takeWhileM p (a:as) = do
    v <- a
    if p v
        then do
            vs <- takeWhileM p as
            return (v:vs)
        else return []

-- SUMS
-- To select the right algorithme according to the type:
-- https://github.com/mikeizbicki/ifcxt

sumSimple :: Num a => [a] -> a
sumSimple = L.foldl' (+) 0

-- | https://en.wikipedia.org/wiki/Kahan_summation_algorithm
sumKahan :: Num a => [a] -> a
sumKahan = snd . L.foldl' go (0,0)
    where
        go (c,t) i = ((t'-t)-y,t')
            where
                y  = i-c
                t' = t+y

-- | compute part of the dict
count2map :: (Ord k, Foldable t) => t k -> Map k Double
count2map xs = M.map (/ (fromIntegral (length xs))) (count2map' xs)

-- | insert in a dict
count2map' :: (Ord k, Foldable t) => t k -> Map k Double
count2map' xs = L.foldl' (\x y -> insertWith (+) y 1 x) M.empty xs

trunc :: (RealFrac a, Integral c, Integral b) => b -> a -> c
trunc n = truncate . (* 10^n)

trunc' :: Int -> Double -> Double
trunc' n x = fromIntegral $ truncate $ (x * 10^n)

------------------------------------------------------------------------
bool2num :: Num a => Bool -> a
bool2num True  = 1
bool2num False = 0

bool2double :: Bool -> Double
bool2double = bool2num

bool2int :: Bool -> Int
bool2int = bool2num
------------------------------------------------------------------------

-- Normalizing && scaling data
scale :: [Double] -> [Double]
scale = scaleMinMax

scaleMinMax :: [Double] -> [Double]
scaleMinMax xs = map (\x -> (x - mi / (ma - mi + 1) )) xs'
    where
        ma  = maximum xs'
        mi  = minimum xs'
        xs' = map abs xs

scaleNormalize :: [Double] -> [Double]
scaleNormalize xs = map (\x -> (x - v / (m + 1))) xs'
    where
        v   = variance  xs'
        m   = mean      xs'
        xs' = map abs   xs

normalize :: [Double] -> [Double]
normalize as = normalizeWith identity as

normalizeWith :: Fractional b => (a -> b) -> [a] -> [b]
normalizeWith extract bs = map (\x -> x/(sum bs')) bs'
    where
        bs' = map extract bs

-- Zip functions to add
zipFst :: ([b] -> [a]) -> [b] -> [(a, b)]
zipFst  f xs = zip (f xs) xs

zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
zipSnd f xs = zip xs (f xs)

-- | maximumWith
maximumWith :: (Ord a1, Foldable t) => (a2 -> a1) -> t a2 -> a2
maximumWith f = L.maximumBy (compare `on` f)

-- | To get all combinations of a list with no
-- repetition and apply a function to the resulting list of pairs
listToCombi :: forall a b. (a -> b) -> [a] -> [(b,b)]
listToCombi f l = [ (f x, f y) | (x:rest) <- L.tails l,  y <- rest ]

------------------------------------------------------------------------
-- Empty List Sugar Error Handling
-- TODO add Garg Monad Errors

listSafe1 :: Text -> ([a] -> Maybe a)
          -> Text -> [a] -> a
listSafe1 s f e xs = maybe (panic $ h <> e) identity (f xs)
  where
    h = "[ERR][Gargantext] Empty list for " <> s <> " in "

head' :: Text -> [a] -> a
head' = listSafe1 "head" headMay

last' :: Text -> [a] -> a
last' = listSafe1 "last" lastMay

------------------------------------------------------------------------

listSafeN :: Text -> ([a] -> Maybe [a])
          -> Text -> [a] -> [a]
listSafeN s f e xs = maybe (panic $ h <> e) identity (f xs)
  where
    h = "[ERR][Gargantext] Empty list for " <> s <> " in "

tail' :: Text -> [a] -> [a]
tail' = listSafeN "tail" tailMay

init' :: Text -> [a] -> [a]
init' = listSafeN "init" initMay

------------------------------------------------------------------------
--- Some Statistics sugar functions
-- Exponential Average
eavg :: [Double] -> Double
eavg (x:xs) = a*x + (1-a)*(eavg xs)
  where a = 0.70
eavg [] = 0

-- Simple Average
mean :: Fractional a => [a] -> a
mean xs = sum xs / fromIntegral (length xs)

sumMaybe :: Num a => [Maybe a] -> Maybe a
sumMaybe = fmap sum . M.sequence

variance :: Floating a => [a] -> a
variance xs = sum ys  / (fromIntegral (length xs) - 1)
  where
    m = mean xs
    ys = map (\x -> (x - m) ** 2) xs

deviation :: Floating a => [a] -> a
deviation = sqrt . variance

movingAverage :: (Eq b, Fractional b) => Int -> [b] -> [b]
movingAverage steps xs = map mean $ chunkAlong steps 1 xs

-----------------------------------------------------------------------
-----------------------------------------------------------------------
--- Map in Map = Map2
-- To avoid Map (a,a) b
type Map2 a b = Map a (Map a b)

lookup2 :: Ord a
        => a
        -> a
        -> Map2 a b
        -> Maybe b
lookup2 a b m = do
  m' <- lookup a m
  lookup b m'

-----------------------------------------------------------------------
foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ z [] = return z
foldM' f z (x:xs) = do
  z' <- f z x
  z' `seq` foldM' f z' xs

-----------------------------------------------------------------------
-- | Instance for basic numerals
-- See the difference between Double and (Int Or Integer)
instance Monoid Double where
  mempty = 1

instance Semigroup Double where
  (<>) a b = a * b

-----------
instance Monoid Int where
  mempty = 0

instance Semigroup Int where
  (<>) a b = a + b
----
instance Monoid Integer where
  mempty = 0

instance Semigroup Integer where
  (<>) a b = a + b

------------------------------------------------------------------------

hasDuplicates :: Ord a => [a] -> Bool
hasDuplicates = hasDuplicatesWith Set.empty

hasDuplicatesWith :: Ord a => Set a -> [a] -> Bool
hasDuplicatesWith _seen [] =
    False -- base case: empty lists never contain duplicates
hasDuplicatesWith  seen (x:xs) =
    -- If we have seen the current item before, we can short-circuit; otherwise,
    -- we'll add it the the set of previously seen items and process the rest of the
    -- list against that.
    x `Set.member` seen || hasDuplicatesWith (Set.insert x seen) xs