-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Gargantext.Prelude
( module Gargantext.Prelude
, round
, sortWith
, module Prelude
+ , MonadBase(..)
+ , Typeable
)
where
-import Control.Monad.IO.Class (liftIO, MonadIO)
-import Control.Concurrent (newEmptyMVar, takeMVar, putMVar, forkIO)
+import Control.Monad.Base (MonadBase(..))
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
- , pure, (>>=), (=<<), (<*>), (<$>), (>>)
- , putStrLn
+ , pure, (>>=), (=<<), (<*>), (<$>), (<&>), (>>)
, head, flip
, Ord, Integral, Foldable, RealFrac, Monad, filter
, reverse, map, mapM, zip, drop, take, zipWith
, (+), (*), (/), (-), (.), ($), (&), (**), (^), (<), (>), log
, Eq, (==), (>=), (<=), (<>), (/=)
, (&&), (||), not, any, all
+ , concatMap
, fst, snd, toS
, elem, die, mod, div, const, either
, curry, uncurry, repeat
, compare
, on
, panic
+ , seq
)
-import Prelude (Enum, Bounded, minBound, maxBound)
+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 qualified Data.List as L hiding (head, sum)
import qualified Control.Monad as M
-
-import Data.Map (Map)
-import qualified Data.Map as M
-
+import qualified Data.Map as M
import Data.Map.Strict (insertWith)
import qualified Data.Vector as V
import Safe (headMay, lastMay, initMay, tailMay)
import Data.String.Conversions (cs)
-printDebug :: (Show a, MonadIO m) => [Char] -> a -> m ()
-printDebug msg x = putStrLn $ msg <> " " <> show x
+printDebug :: (Show a, MonadBase IO m) => [Char] -> a -> m ()
+printDebug msg x = liftBase . putStrLn $ msg <> " " <> show x
-- printDebug _ _ = pure ()
movingAverage :: (Eq b, Fractional b) => Int -> [b] -> [b]
movingAverage steps xs = map mean $ chunkAlong steps 1 xs
-ma :: [Double] -> [Double]
-ma = movingAverage 3
-
-
-----------------------------------------------------------------------
-fib :: Int -> Int
-fib 0 = 0
-fib 1 = 1
-fib n = fib (n-1) + fib (n-2)
-
-
+-----------------------------------------------------------------------
+--- 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'
-----------------------------------------------------------------------
--- Memory Optimization
-
-inMVarIO :: MonadIO m => m b -> m b
-inMVarIO f = do
- mVar <- liftIO newEmptyMVar
- zVar <- f
- _ <- liftIO $ forkIO $ putMVar mVar zVar
- liftIO $ takeMVar mVar
-
-inMVar :: b -> IO b
-inMVar f = do
- mVar <- newEmptyMVar
- let zVar = f
- _ <- liftIO $ forkIO $ putMVar mVar zVar
- liftIO $ takeMVar mVar
+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