Remove files with wrong extension

Some files in `src/` contain Haskell syntax, yet have the wrong extension
(`.sh`, `.purs`, `.old`, `.hs.old`). They are not picked up by Cabal.

They were most probably saved with the wrong extension by mistake,
and forgotten about. Since the project builds fine without them, I think
it is safe to say that they are not needed and can be safely removed.

src/Gargantext/API/GraphQL/Contact.sh

-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-
-module Gargantext.API.GraphQL.Contact where
-
-import Control.Lens
-import Data.Morpheus.Types
-  ( GQLType
-  , Resolver
-  , ResolverM
-  , QUERY
-  , lift
-  )
-import Data.Text (Text)
-import qualified Data.Text as T
-import Gargantext.API.Prelude (GargM, GargError)
-import Gargantext.Core.Mail.Types (HasMail)
-import Gargantext.Database.Admin.Types.Hyperdata
-  ( HyperdataUser(..)
-  , hc_source
-  , hc_title
-  , hu_shared)
-import Gargantext.Database.Admin.Types.Hyperdata.Contact
-  ( HyperdataContact
-  , ContactWho
-  , ContactWhere
-  , cw_city
-  , cw_country
-  , cw_firstName
-  , cw_lastName
-  , cw_labTeamDepts
-  , cw_office
-  , cw_organization
-  , cw_role
-  , cw_touch
-  , ct_mail
-  , ct_phone
-  , hc_who
-  , hc_where)
-import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
-import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
-import Gargantext.Database.Query.Table.User (getUsersWithHyperdata, getUsersWithNodeHyperdata)
-import Gargantext.Database.Schema.User (UserLight(..))
-import Gargantext.Database.Schema.Node (node_id, node_hyperdata)
-import Gargantext.Prelude
-import GHC.Generics (Generic)
-
-data UserInfo = UserInfo
-  { ui_id             :: Int
-  , ui_username       :: Text
-  , ui_email          :: Text
-  , ui_title          :: Maybe Text
-  , ui_source         :: Maybe Text
-  , ui_cwFirstName    :: Maybe Text
-  , ui_cwLastName     :: Maybe Text
-  , ui_cwCity         :: Maybe Text
-  , ui_cwCountry      :: Maybe Text
-  , ui_cwOrganization :: [Text]
-  , ui_cwLabTeamDepts :: [Text]
-  , ui_cwOffice       :: Maybe Text
-  , ui_cwRole         :: Maybe Text
-  , ui_cwTouchPhone   :: Maybe Text
-  , ui_cwTouchMail    :: Maybe Text }
-  deriving (Generic, GQLType, Show)
-
--- | Arguments to the "user info" query.
-data UserInfoArgs
-  = UserInfoArgs
-    { user_id :: Int
-    } deriving (Generic, GQLType)
-
--- | Arguments to the "user info" mutation,
-data UserInfoMArgs
-  = UserInfoMArgs
-    { ui_id             :: Int
-    , ui_username       :: Maybe Text
-    , ui_email          :: Maybe Text
-    , ui_title          :: Maybe Text
-    , ui_source         :: Maybe Text
-    , ui_cwFirstName    :: Maybe Text
-    , ui_cwLastName     :: Maybe Text
-    , ui_cwCity         :: Maybe Text
-    , ui_cwCountry      :: Maybe Text
-    , ui_cwOrganization :: Maybe [Text]
-    , ui_cwLabTeamDepts :: Maybe [Text]
-    , ui_cwOffice       :: Maybe Text
-    , ui_cwRole         :: Maybe Text
-    , ui_cwTouchPhone   :: Maybe Text
-    , ui_cwTouchMail    :: Maybe Text
-    } deriving (Generic, GQLType)
-
-type GqlM e env = Resolver QUERY e (GargM env GargError)
-
--- | Function to resolve user from a query.
-resolveUserInfos
-  :: (HasConnectionPool env, HasConfig env, HasMail env)
-  => UserInfoArgs -> GqlM e env [UserInfo]
-resolveUserInfos UserInfoArgs { user_id } = do
-  lift $ printDebug "[resolveUserInfo] ui_id" user_id
-  dbUsers user_id
-
--- | Mutation for user info
-updateUserInfo
-  :: (HasConnectionPool env, HasConfig env, HasMail env)
-  => UserInfoMArgs -> ResolverM e (GargM env GargError) Int
-updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
-  lift $ printDebug "[updateUserInfo] ui_id" ui_id
-  users <- lift (getUsersWithNodeHyperdata ui_id)
-  case users of
-    [] -> panicTrace $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
-    ((_u, node_u):_) -> do
-      let u_hyperdata = node_u ^. node_hyperdata
-      -- lift $ printDebug "[updateUserInfo] u" u
-      let u_hyperdata' = uh ui_titleL ui_title $
-                         uh ui_sourceL ui_source $
-                         uh ui_cwFirstNameL ui_cwFirstName $
-                         uh ui_cwLastNameL ui_cwLastName $
-                         uh ui_cwCityL ui_cwCity $
-                         uh ui_cwCountryL ui_cwCountry $
-                         uh' ui_cwLabTeamDeptsL ui_cwLabTeamDepts $
-                         uh' ui_cwOrganizationL ui_cwOrganization $
-                         uh ui_cwOfficeL ui_cwOffice $
-                         uh ui_cwRoleL ui_cwRole $
-                         uh ui_cwTouchMailL ui_cwTouchMail $
-                         uh ui_cwTouchPhoneL ui_cwTouchPhone $
-                         u_hyperdata
-      -- lift $ printDebug "[updateUserInfo] with firstName" u_hyperdata'
-      _ <- lift $ updateHyperdata (node_u ^. node_id) u_hyperdata'
-      --let _newUser = toUser (u, u_hyperdata')
-      pure 1
-  where
-    uh _ Nothing u_hyperdata = u_hyperdata
-    uh lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ Just val
-    uh' _ Nothing u_hyperdata = u_hyperdata
-    uh' lens' (Just val) u_hyperdata = u_hyperdata & lens' .~ val
-
--- | Inner function to fetch the user from DB.
-dbUsers
-  :: (HasConnectionPool env, HasConfig env, HasMail env)
-  => Int -> GqlM e env [UserInfo]
-dbUsers user_id = do
-  -- lift $ printDebug "[dbUsers]" user_id
---  user <- getUsersWithId user_id
---  hyperdata <- getUserHyperdata user_id
---  lift (map toUser <$> zip user hyperdata)
-  lift (map toUser <$> (getUsersWithHyperdata user_id))
-
-toUser :: (UserLight, HyperdataUser) -> UserInfo
-toUser (UserLight { .. }, u_hyperdata) =
-  UserInfo { ui_id             = userLight_id
-           , ui_username       = userLight_username
-           , ui_email          = userLight_email
-           , ui_title          = u_hyperdata ^. ui_titleL
-           , ui_source         = u_hyperdata ^. ui_sourceL
-           , ui_cwFirstName    = u_hyperdata ^. ui_cwFirstNameL
-           , ui_cwLastName     = u_hyperdata ^. ui_cwLastNameL
-           , ui_cwCity         = u_hyperdata ^. ui_cwCityL
-           , ui_cwCountry      = u_hyperdata ^. ui_cwCountryL
-           , ui_cwLabTeamDepts = u_hyperdata ^. ui_cwLabTeamDeptsL
-           , ui_cwOrganization = u_hyperdata ^. ui_cwOrganizationL
-           , ui_cwOffice       = u_hyperdata ^. ui_cwOfficeL
-           , ui_cwRole         = u_hyperdata ^. ui_cwRoleL
-           , ui_cwTouchMail    = u_hyperdata ^. ui_cwTouchMailL
-           , ui_cwTouchPhone   = u_hyperdata ^. ui_cwTouchPhoneL }
-
-sharedL :: Traversal' HyperdataUser HyperdataContact
-sharedL = hu_shared . _Just
-ui_titleL :: Traversal' HyperdataUser (Maybe Text)
-ui_titleL = sharedL . hc_title
-ui_sourceL :: Traversal' HyperdataUser (Maybe Text)
-ui_sourceL = sharedL . hc_source
-contactWhoL :: Traversal' HyperdataUser ContactWho
-contactWhoL = sharedL . hc_who . _Just
-ui_cwFirstNameL :: Traversal' HyperdataUser (Maybe Text)
-ui_cwFirstNameL = contactWhoL . cw_firstName
-ui_cwLastNameL :: Traversal' HyperdataUser (Maybe Text)
-ui_cwLastNameL = contactWhoL . cw_lastName
-contactWhereL :: Traversal' HyperdataUser ContactWhere
-contactWhereL = sharedL . hc_where . (ix 0)
-ui_cwCityL :: Traversal' HyperdataUser (Maybe Text)
-ui_cwCityL = contactWhereL . cw_city
-ui_cwCountryL :: Traversal' HyperdataUser (Maybe Text)
-ui_cwCountryL = contactWhereL . cw_country
-ui_cwLabTeamDeptsL :: Traversal' HyperdataUser [Text]
-ui_cwLabTeamDeptsL = hu_shared . _Just . (hc_where . (ix 0) . cw_labTeamDepts)
-ui_cwOrganizationL :: Traversal' HyperdataUser [Text]
-ui_cwOrganizationL = hu_shared . _Just . (hc_where . (ix 0) . cw_organization)
-ui_cwOfficeL :: Traversal' HyperdataUser (Maybe Text)
-ui_cwOfficeL = contactWhereL . cw_office
-ui_cwRoleL :: Traversal' HyperdataUser (Maybe Text)
-ui_cwRoleL = contactWhereL . cw_role
-ui_cwTouchMailL :: Traversal' HyperdataUser (Maybe Text)
-ui_cwTouchMailL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_mail)
---ui_cwTouchMailL = contactWhereL . cw_touch . _Just . ct_mail
-ui_cwTouchPhoneL :: Traversal' HyperdataUser (Maybe Text)
-ui_cwTouchPhoneL = hu_shared . _Just . (hc_where . (ix 0) . cw_touch . _Just . ct_phone)
---ui_cwTouchPhoneL = contactWhereL . cw_touch . _Just . ct_phone

src/Gargantext/Core/NodeStoryFile.hs.old

-{-|
-Module      : Gargantext.API.Ngrams.Types
-Description : Ngrams List Types
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
-NOTE This is legacy code. It keeps node stories in a directory
- repo. We now have migrated to the DB. However this code is needed to
- make the migration (see  Gargantext.API.Ngrams.Tools)
-
--}
-
-module Gargantext.Core.NodeStoryFile where
-
-import Codec.Serialise (serialise, deserialise)
-import Codec.Serialise.Class
-import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
-import Control.Lens (view)
-import Data.ByteString.Lazy qualified as DBL
-import Data.List qualified as List
-import Data.Map.Strict qualified as Map
-import Gargantext.Core.NodeStory hiding (fromDBNodeStoryEnv)
-import Gargantext.Core.Types (ListId, NodeId(..))
-import Gargantext.Database.Prelude (hasConfig)
-import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
-import Gargantext.Prelude
-import Gargantext.Core.Config (gc_repofilepath)
-import System.Directory (renameFile, createDirectoryIfMissing, doesFileExist, removeFile)
-import System.IO (hClose)
-import System.IO.Temp (withTempFile)
-
-
-getRepo :: HasNodeStory env err m
-         => [ListId] -> m NodeListStory
-getRepo listIds = do
-  g <- getNodeListStory
-  liftBase $ do
-    v <- g listIds
-    readMVar v
-  -- v  <- liftBase $ f listIds
-  -- v' <- liftBase $ readMVar v
-  -- pure $ v'
-
-getRepoReadConfig :: (HasNodeStory env err m)
-             => [ListId] -> m NodeListStory
-getRepoReadConfig listIds = do
-  repoFP <- view $ hasConfig . gc_repofilepath
-  env <- liftBase $ readNodeStoryEnv repoFP
-  let g = view nse_getter env
-  liftBase $ do
-    v <- g listIds
-    readMVar v
-
-getNodeListStory :: HasNodeStory env err m
-                 => m ([NodeId] -> IO (MVar NodeListStory))
-getNodeListStory = do
-  env <- view hasNodeStory
-  pure $ view nse_getter env
-
-
-
-readNodeStoryEnv :: NodeStoryDir -> IO NodeStoryEnv
-readNodeStoryEnv nsd = do
-  mvar  <- nodeStoryVar nsd Nothing []
-  saver <- mkNodeStorySaver nsd mvar
-  let saver_immediate = withMVar mvar (writeNodeStories nsd)
-  let archive_saver_immediate ns = pure ns
-  pure $ NodeStoryEnv { _nse_var = mvar
-                      , _nse_saver = saver
-                      , _nse_saver_immediate = saver_immediate
-                      , _nse_archive_saver_immediate = archive_saver_immediate
-                      , _nse_getter = nodeStoryVar nsd (Just mvar) }
-
-------------------------------------------------------------------------
-mkNodeStorySaver :: NodeStoryDir -> MVar NodeListStory -> IO (IO ())
-mkNodeStorySaver nsd mvns = mkDebounce settings
-  where
-    settings = defaultDebounceSettings
-                 { debounceAction = withMVar mvns (writeNodeStories nsd)
-                 , debounceFreq = 1 * minute
---                 , debounceEdge = trailingEdge -- Trigger on the trailing edge
-                 }
-    minute = 60 * sec
-    sec = 10^(6 :: Int)
-
-nodeStoryVar :: NodeStoryDir
-             -> Maybe (MVar NodeListStory)
-             -> [NodeId]
-             -> IO (MVar NodeListStory)
-nodeStoryVar nsd Nothing ni = nodeStoryIncs nsd Nothing ni >>= newMVar
-nodeStoryVar nsd (Just mv) ni = do
-  _ <- modifyMVar_ mv $ \mv' -> (nodeStoryIncs nsd (Just mv') ni)
-  pure mv
-
-
-nodeStoryInc :: NodeStoryDir -> Maybe NodeListStory -> NodeId -> IO NodeListStory
-nodeStoryInc nsd (Just ns@(NodeStory nls)) ni = do
-  case Map.lookup ni nls of
-    Nothing -> do
-      (NodeStory nls') <- nodeStoryRead nsd ni
-      pure $ NodeStory $ Map.union nls nls'
-    Just _  -> pure ns
-nodeStoryInc nsd Nothing ni = nodeStoryRead nsd ni
-
-
-nodeStoryIncs :: NodeStoryDir
-              -> Maybe NodeListStory
-              -> [NodeId]
-              -> IO NodeListStory
-nodeStoryIncs _ Nothing    []        = pure $ NodeStory $ Map.empty
-nodeStoryIncs nsd (Just nls) ns      = foldM (\m n -> nodeStoryInc nsd (Just m) n) nls ns
-nodeStoryIncs nsd Nothing    (ni:ns) = do
-  m <- nodeStoryRead nsd ni
-  nodeStoryIncs nsd (Just m) ns
-
-
-nodeStoryDec :: NodeStoryDir
-             -> NodeListStory
-             -> NodeId
-             -> IO NodeListStory
-nodeStoryDec nsd ns@(NodeStory nls) ni = do
-  case Map.lookup ni nls of
-    Nothing -> do
-      -- we make sure the corresponding file repo is really removed
-      _ <- nodeStoryRemove nsd ni
-      pure ns
-    Just _  -> do
-      let ns' = Map.filterWithKey (\k _v -> k /= ni) nls
-      _ <- nodeStoryRemove nsd ni
-      pure $ NodeStory ns'
-
--- | TODO lock
-nodeStoryRead :: NodeStoryDir -> NodeId -> IO NodeListStory
-nodeStoryRead nsd ni = do
-  _repoDir <- createDirectoryIfMissing True nsd
-  let nsp = nodeStoryPath nsd ni
-  exists <- doesFileExist nsp
-  if exists
-     then deserialise <$> DBL.readFile nsp
-     else pure (initNodeStory ni)
-
-nodeStoryRemove :: NodeStoryDir -> NodeId -> IO ()
-nodeStoryRemove nsd ni = do
-  let nsp = nodeStoryPath nsd ni
-  exists <- doesFileExist nsp
-  if exists
-     then removeFile nsp
-     else pure ()
-
-
-
-nodeStoryRead_test :: NodeStoryDir -> NodeId -> IO (Maybe [ TableNgrams.NgramsType ])
-nodeStoryRead_test nsd ni = nodeStoryRead nsd ni >>= \n -> pure
-                          $ fmap Map.keys
-                          $ fmap _a_state
-                          $ Map.lookup ni
-                          $ _unNodeStory n
-
-------------------------------------------------------------------------
-type NodeStoryDir = FilePath
-
-writeNodeStories :: NodeStoryDir -> NodeListStory -> IO ()
-writeNodeStories fp nls = do
-  _done <- mapM (writeNodeStory fp) $ splitByNode nls
-  -- printDebug "[writeNodeStories]" done
-  pure ()
-
-writeNodeStory :: NodeStoryDir -> (NodeId, NodeListStory) -> IO ()
-writeNodeStory rdfp (n, ns) = saverAction' rdfp n ns
-
-splitByNode :: NodeListStory -> [(NodeId, NodeListStory)]
-splitByNode (NodeStory m) =
-  List.map (\(n,a) -> (n, NodeStory $ Map.singleton n a)) $ Map.toList m
-
-
-saverAction' :: Serialise a => NodeStoryDir -> NodeId -> a -> IO ()
-saverAction' repoDir nId a = do
-  withTempFile repoDir ((show nId) <> "-tmp-repo.cbor") $ \fp h -> do
-    -- printDebug "[repoSaverAction]" fp
-    DBL.hPut h $ serialise a
-    hClose h
-    renameFile fp (nodeStoryPath repoDir nId)
-
-nodeStoryPath :: NodeStoryDir -> NodeId -> FilePath
-nodeStoryPath repoDir nId = repoDir <> "/" <> filename
-  where
-    filename = "repo" <> "-" <> (show nId) <> ".cbor"
-
-
-------------------------------------------------------------------------
--- TODO : repo Migration TODO TESTS
-{-
-repoMigration :: NodeStoryDir -> NgramsRepo -> IO ()
-repoMigration fp r = writeNodeStories fp (repoToNodeListStory r)
-
-repoToNodeListStory :: NgramsRepo -> NodeListStory
-repoToNodeListStory (Repo _v s h) = NodeStory $ Map.fromList ns
-  where
-    s' = ngramsState_migration      s
-    h' = ngramsStatePatch_migration h
-    ns = List.map (\(n,ns')
-                    -> (n, let hs = fromMaybe [] (Map.lookup n h') in
-                               Archive { _a_version = List.length hs
-                                       , _a_state = ns'
-                                       , _a_history = hs }
-                       )
-                  ) $ Map.toList s'
-
-ngramsState_migration :: NgramsState
-                      -> Map NodeId NgramsState'
-ngramsState_migration ns =
-  Map.fromListWith (Map.union) $
-  List.concat $
-    map (\(nt, nTable)
-          -> map (\(nid, table)
-                   -> (nid, Map.singleton nt table)
-                 ) $ Map.toList nTable
-        ) $ Map.toList ns
-
-
-ngramsStatePatch_migration :: [NgramsStatePatch]
-                           -> Map NodeId [NgramsStatePatch']
-ngramsStatePatch_migration np' = Map.fromListWith (<>)
-                               $ List.concat
-                               $ map toPatch np'
-  where
-    toPatch :: NgramsStatePatch -> [(NodeId, [NgramsStatePatch'])]
-    toPatch p =
-      List.concat $
-        map (\(nt, nTable)
-              -> map (\(nid, table)
-                       -> (nid, [fst $ Patch.singleton nt table])
-                     ) $ Patch.toList nTable
-            ) $ Patch.toList p
--}

src/Gargantext/Core/Text/Metrics/Hetero.purs

-{-|
-Module      : Gargantext.
-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@.
--}
-
-module Gargantext.Text.Hetero where
-
-import Data.List.Split as S
-import Data.Map as M
-import Data.Set as S
-import Database.PostgreSQL.Simple as PGS
-import GHC.Real as R
-import Gargantext.Database.Admin.Gargandb
-import Gargantext.Database.Admin.Private
-import Gargantext.Database.Simple
-import Gargantext.Text.Count (occurrences)
-import Gargantext.Text.Words (cleanText)
-import Opaleye.Internal.Column (Column)
-import Opaleye.PGTypes (PGInt4)
-
---main = do
---    t <- getTextquery
---    print (Prelude.map (heterogeinity . concat) $ S.chunksOf 3 t) 
-
--- heterogeinity sur concat texts
-heterogeinity' :: Int -> Int -> Int -> IO [Integer]
-heterogeinity' corpus_id limit x = do
-    t <- getAbstract corpus_id limit
-    Prelude.mapM (dicoStruct . occurrences) $ (S.chunksOf x) .  cleanText $ concat t
-
-heterogeinity'' :: Int -> Int -> Int -> IO [Integer]
-heterogeinity'' corpus_id limit size = do
-    t <- getAbstract corpus_id limit
-    Prelude.mapM (dicoStruct . occurrences) $ (S.chunksOf size) .  cleanText $ concat t
-
-
-dicoStruct :: (Integral r, Monad m) => M.Map t r -> m r
-dicoStruct dict_occ = do
-    let keys_size = toInteger $ length $ M.keys dict_occ
-    let total_occ = sum $ Prelude.map (\(x, y) -> y) $ M.toList dict_occ
-    pure $ div total_occ (fromIntegral keys_size)
-
--- heterogeinity sur UCT (Unité de Context Textuel)
-heterogeinity :: [Char] -> IO Integer
-heterogeinity string = do
-    let dict_occ = occurrences $ cleanText string
-
-    let keys_size = toInteger $ length $ M.keys dict_occ
-    let total_occ = sum $ Prelude.map (\(x, y) -> y) $ M.toList dict_occ
-
-    pure $ div total_occ (fromIntegral keys_size)
-
-
---computeHeterogeinity
---  :: Fractional t =>
---       Opaleye.Internal.Column.Column Opaleye.PGTypes.PGInt4
---            -> IO (t, Integer, Integer)
-computeHeterogeinity corpus_id = do
-    c <- PGS.connect infoGargandb
-    t <- getText c (nodeHyperdataText corpus_id)
-    heterogeinity $ Prelude.concat t
-
-main2 = do
-    let corpus_ids = [
-                ("ALL", 272927) -- 73
-               ,("Histoire", 1387736) -- 28
-               ,("Sciences Po", 1296892) -- 37
-               ,("Phylosophie", 1170004) -- 20
-               ,("Psychologie", 1345852) -- 37
-               ,("Sociologie", 1246452)  -- 42
-               ]
-    
-    r <- Prelude.map computeHeterogeinity $ Prelude.map (\(t,id) -> id) corpus_ids
-    pure r
-
-

src/Gargantext/Core/Utils/Count.purs

-{-|
-Module      : Gargantext.Core.Utils.Count
-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@.
-
-Inspired from Gabriel Gonzales, "beautiful folds" talk.
-
--}
-
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE BangPatterns #-}
-
-module Gargantext.Core.Utils.Count (head, last, all, any, sum, product, length)
-    where
-
-import Data.Functor
-import Control.Applicative
-import qualified Data.Foldable
-import Data.Monoid
-import Control.Lens (Getting, foldMapOf)
-
-import Gargantext.Prelude hiding (head, sum, length)
-
-data Fold i o = forall m . Monoid m => Fold (i -> m) (m -> o)
-
-instance Functor (Fold i) where
-    fmap k (Fold tally summarize) = Fold tally (k . summarize)
-
-instance Applicative (Fold i) where
-    pure o = Fold (\_ -> ()) (\_ -> o)
-
-    Fold tallyF summarizeF <*> Fold tallyX summarizeX = Fold tally summarize
-        where
-            tally i = (tallyF i, tallyX i)
-            summarize (nF, nX) = summarizeF nF (summarizeX nX)
-
-focus :: (forall m . Monoid m => Getting m b a) -> Fold a o -> Fold b o
-focus lens (Fold tally summarize) = Fold (foldMapOf lens tally) summarize
-
-
-fold :: Fold i o -> [i] -> o
-fold (Fold tally summarize) is = summarize (reduce (map tally is))
-    where
-        reduce = Data.Foldable.foldl' (<>) mempty
-
---
-head :: Fold a (Maybe a)
-head = Fold (First . Just) getFirst
-
-last :: Fold a (Maybe a)
-last = Fold (Last . Just) getLast
---
-all :: (a -> Bool) -> Fold a Bool
-all predicate = Fold (All . predicate) getAll
-
-any :: (a -> Bool) -> Fold a Bool
-any predicate = Fold (Any . predicate) getAny
---
-sum :: Num n => Fold n n
-sum = Fold Sum getSum
-
-product :: Num n => Fold n n
-product = Fold Product getProduct
-
-length :: Num n => Fold i n
-length = Fold (\_ -> Sum 1) getSum
-
-
--- | Average function optimized (/!\ need to test it)
-data Average a = Average { numerator :: !a, denominator :: !Int }
-
-instance Num a => Monoid (Average a) where
-    mempty = Average 0 0
-    mappend (Average xL nL) (Average xR nR) = Average (xL + xR) (nL + nR)
-
-average :: Fractional a => Fold a a
-average = Fold tally summarize
-    where
-        tally x = Average x 1
-        summarize (Average numerator denominator) =
-            numerator / fromIntegral denominator