install: proposal
[gargantext.git] / src / Gargantext / Prelude.hs
index 4c87d551cd12500b0e1de289fb3768f41c46b611..98a9905a9ab7da6b7b91156b63b61da01fe68a25 100644 (file)
@@ -1,42 +1,79 @@
+{-|
+Module      : Gargantext.Prelude
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Here is a longer description of this module, containing some
+commentary with @some markup@.
+-}
+
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults  #-}
-{-# LANGUAGE     NoImplicitPrelude       #-}
 
-{-
-TODO: import head impossible from Protolude: why ?
--}
+{-# LANGUAGE     NoImplicitPrelude       #-}
 
 module Gargantext.Prelude
   ( module Gargantext.Prelude
   , module Protolude
-  , headMay
+  , headMay, lastMay
+  , module Text.Show
+  , module Text.Read
+  , cs
+  , module Data.Maybe
+  , sortWith
   )
   where
 
-import Protolude ( Bool(True, False), Int, Double, Integer
+import GHC.Exts (sortWith)
+
+import Data.Maybe (isJust, fromJust, maybe)
+import Protolude ( Bool(True, False), Int, Int64, Double, Integer
                  , Fractional, Num, Maybe(Just,Nothing)
+                 , Enum, Bounded, Float
                  , Floating, Char, IO
-                 , pure, (<$>), panic
+                 , pure, (>>=), (=<<), (<*>), (<$>), panic
+                 , putStrLn
+                 , head, flip
                  , Ord, Integral, Foldable, RealFrac, Monad, filter
-                 , reverse, map, zip, drop, take, zipWith
-                 , sum, fromIntegral, length, fmap
+                 , reverse, map, mapM, zip, drop, take, zipWith
+                 , sum, fromIntegral, length, fmap, foldl, foldl'
                  , takeWhile, sqrt, undefined, identity
-                 , abs, maximum, minimum, return, snd, truncate
-                 , (+), (*), (/), (-), (.), (>=), ($), (**), (^)
+                 , abs, min, max, maximum, minimum, return, snd, truncate
+                 , (+), (*), (/), (-), (.), ($), (&), (**), (^), (<), (>), log
+                 , Eq, (==), (>=), (<=), (<>), (/=)
+                 , (&&), (||), not, any
+                 , fst, snd, toS
+                 , elem, die, mod, div, const, either
+                 , curry, uncurry, repeat
+                 , otherwise, when
+                 , undefined
+                 , IO()
+                 , compare
+                 , on
                  )
 
 -- TODO import functions optimized in Utils.Count
 -- import Protolude hiding (head, last, all, any, sum, product, length)
 -- import Gargantext.Utils.Count
-
 import qualified Data.List     as L hiding (head, sum)
 import qualified Control.Monad as M
-import qualified Data.Map as Map
+
+import Data.Map (Map)
+import qualified Data.Map as M
+
+import Data.Map.Strict (insertWith)
 import qualified Data.Vector as V
-import Safe (headMay)
+import Safe (headMay, lastMay)
+import Text.Show (Show(), show)
+import Text.Read (Read())
+import Data.String.Conversions (cs)
 
-pf :: (a -> Bool) -> [a] -> [a]
-pf = filter
+--pf :: (a -> Bool) -> [a] -> [a]
+--pf = filter
 
 pr :: [a] -> [a]
 pr = reverse
@@ -44,20 +81,8 @@ pr = reverse
 --pm :: (a -> b) -> [a] -> [b]
 --pm = map
 
-pm2 :: (t -> b) -> [[t]] -> [[b]]
-pm2 fun = map (map fun)
-
-pz :: [a] -> [b] -> [(a, b)]
-pz  = zip
-
-pd :: Int -> [a] -> [a]
-pd  = drop
-
-ptk :: Int -> [a] -> [a]
-ptk = take
-
-pzw :: (a -> b -> c) -> [a] -> [b] -> [c]
-pzw = zipWith
+map2 :: (t -> b) -> [[t]] -> [[b]]
+map2 fun = map (map fun)
 
 -- Exponential Average
 eavg :: [Double] -> Double
@@ -86,6 +111,12 @@ movingAverage steps xs = map mean $ chunkAlong steps 1 xs
 ma :: [Double] -> [Double]
 ma = movingAverage 3
 
+-- | 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
 
 -- | Function to split a range into chunks
 chunkAlong :: Int -> Int -> [a] -> [[a]]
@@ -141,12 +172,12 @@ sumKahan = snd . L.foldl' go (0,0)
                 t' = t+y
 
 -- | compute part of the dict
-count2map :: (Ord k, Foldable t) => t k -> Map.Map k Double
-count2map xs = Map.map (/ (fromIntegral (length xs))) (count2map' xs)
+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.Map k Double
-count2map' xs = L.foldl' (\x y -> Map.insertWith' (+) y 1 x) Map.empty xs
+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
@@ -202,3 +233,12 @@ zipFst  f xs = zip (f xs) xs
 
 zipSnd :: ([a] -> [b]) -> [a] -> [(a, b)]
 zipSnd f xs = zip xs (f xs)
+
+-- Just 
+unMaybe :: [Maybe a] -> [a]
+unMaybe = map fromJust . L.filter isJust
+
+-- | maximumWith
+maximumWith :: (Ord a1, Foldable t) => (a2 -> a1) -> t a2 -> a2
+maximumWith f = L.maximumBy (compare `on` f)
+