+{-|
+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
--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
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]]
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
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)
+