{-|
Module      : Gargantext.Core.Text.Ngrams.Lists
Description : Tools to build lists
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

module Gargantext.Core.Text.List
  where


import Control.Lens ((^.), view, over)
import Data.Map (Map)
import Data.Maybe (catMaybes)
import Data.Monoid (mempty)
import Data.Ord (Down(..))
import Data.Set (Set)
import Data.Text (Text)
import Data.Tuple.Extra (both)
import Gargantext.API.Ngrams.Types (NgramsElement)
import Gargantext.API.Ngrams.Types (RepoCmdM)
import Gargantext.Core.Text.List.Group
import Gargantext.Core.Text.List.Group.Prelude
import Gargantext.Core.Text.List.Group.WithStem
import Gargantext.Core.Text.List.Social
import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.Metrics (scored', Scored(..), normalizeGlobal, normalizeLocal)
import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsUser, getNodesByNgramsOnlyUser)
import Gargantext.Database.Action.Metrics.TFICF (getTficf)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude (CmdM)
import Gargantext.Database.Query.Table.Node (defaultList)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
import Gargantext.Database.Query.Tree.Error (HasTreeError)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map  as Map
import qualified Data.Set  as Set
import qualified Data.Text as Text


-- | TODO improve grouping functions of Authors, Sources, Institutes..
buildNgramsLists :: ( RepoCmdM env err m
                    , CmdM     env err m
                    , HasTreeError err
                    , HasNodeError err
                    )
                 => User
                 -> GroupParams
                 -> UserCorpusId
                 -> MasterCorpusId
                 -> m (Map NgramsType [NgramsElement])
buildNgramsLists user gp uCid mCid = do
  ngTerms     <- buildNgramsTermsList user uCid mCid gp
  othersTerms <- mapM (buildNgramsOthersList user uCid GroupIdentity)
                      [ (Authors   , MapListSize 9)
                      , (Sources   , MapListSize 9)
                      , (Institutes, MapListSize 9)
                      ]

  pure $ Map.unions $ [ngTerms] <> othersTerms


data MapListSize = MapListSize { unMapListSize :: !Int }

buildNgramsOthersList ::( HasNodeError err
                        , CmdM     env err m
                        , RepoCmdM env err m
                        , HasTreeError err
                        )
                        => User
                        -> UserCorpusId
                        -> GroupParams
                        -> (NgramsType, MapListSize)
                        -> m (Map NgramsType [NgramsElement])
buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
  ngs'  :: Map Text (Set NodeId) <- getNodesByNgramsUser uCid nt

  -- | PrivateFirst for first developments since Public NodeMode is not implemented yet
  socialLists' :: FlowCont Text FlowListScores
    <- flowSocialList' MySelfFirst user nt ( FlowCont Map.empty
                                                      $ Map.fromList
                                                      $ List.zip (Map.keys ngs') 
                                                                 (List.cycle [mempty])
                                           )

{-
  printDebug "flowSocialList'"
               $ Map.filter (not . ((==) Map.empty) . (view fls_parents))
               $ view flc_scores socialLists'
-}
  let
    groupedWithList = toGroupedTreeText groupIt socialLists' ngs'

  printDebug "groupedWithList"
              $ view flc_cont groupedWithList

  let
    (stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType) $ view flc_scores groupedWithList
    (mapTerms, tailTerms') = Map.partition ((== Just MapTerm)  . viewListType) tailTerms

    listSize = mapListSize - (List.length mapTerms)
    (mapTerms', candiTerms) = both Map.fromList
                            $ List.splitAt listSize
                            $ List.sortOn (Down . viewScore . snd)
                            $ Map.toList tailTerms'

  pure $ Map.fromList [( nt,  (toNgramsElement stopTerms)
                           <> (toNgramsElement mapTerms )
                           <> (toNgramsElement $ setListType (Just MapTerm      ) mapTerms' )
                           <> (toNgramsElement $ setListType (Just CandidateTerm) candiTerms)
                      )]


-- TODO use ListIds
buildNgramsTermsList :: ( HasNodeError err
                        , CmdM     env err m
                        , RepoCmdM env err m
                        , HasTreeError err
                        )
                        => User
                        -> UserCorpusId
                        -> MasterCorpusId
                        -> GroupParams
                        -> m (Map NgramsType [NgramsElement])
buildNgramsTermsList user uCid mCid groupParams = do

-- Computing global speGen score
  allTerms :: Map Text Double <- getTficf uCid mCid NgramsTerms

  -- printDebug "head candidates" (List.take 10 $ allTerms)
  -- printDebug "tail candidates" (List.take 10 $ List.reverse $ allTerms)

  -- First remove stops terms
  socialLists <- flowSocialList user NgramsTerms (Set.fromList $ map fst $ Map.toList allTerms)
  -- printDebug "\n * socialLists * \n" socialLists

  -- Grouping the ngrams and keeping the maximum score for label
  let grouped = groupedTextWithStem ( GroupedTextParams (groupWith groupParams) identity (const Set.empty) (const Set.empty) {-(size . _gt_label)-} ) allTerms

      groupedWithList = map (addListType (invertForw socialLists)) grouped

      (stopTerms, candidateTerms) = Map.partition ((== Just StopTerm) . viewListType) groupedWithList
      (groupedMono, groupedMult)  = Map.partition (\t -> t ^. gt_size                  < 2) candidateTerms
      -- (groupedMono, groupedMult)  = Map.partitionWithKey (\t -> t ^. gt_size                  < 2) candidateTerms

  -- printDebug "\n * stopTerms * \n" stopTerms
  -- splitting monterms and multiterms to take proportional candidates
  let
    listSizeGlobal = 2000 :: Double -- use % of list if to big, or Int if too small
    monoSize = 0.4  :: Double
    multSize = 1 - monoSize

    splitAt n' ns = List.splitAt (round $ n' * listSizeGlobal) $ List.sort $ Map.elems ns

    (groupedMonoHead, groupedMonoTail) = splitAt monoSize groupedMono
    (groupedMultHead, groupedMultTail) = splitAt multSize groupedMult

  -- printDebug "groupedMonoHead" (List.length groupedMonoHead)
  -- printDebug "groupedMonoTail" (List.length groupedMonoHead)
  -- printDebug "groupedMultHead" (List.length groupedMultHead)
  -- printDebug "groupedMultTail" (List.length groupedMultTail)

  let
    -- Get Local Scores now for selected grouped ngrams
    -- TODO HasTerms 
    selectedTerms = Set.toList $ List.foldl'
                      (\set' (GroupedText _ l' _ g _ _ _ ) -> Set.union set'
                                                            $ Set.insert l' g
                      )
                      Set.empty  
                      (groupedMonoHead <> groupedMultHead)
    -- selectedTerms = hasTerms (groupedMonoHead <> groupedMultHead)

  -- TO remove (and remove HasNodeError instance)
  userListId    <- defaultList uCid
  masterListId  <- defaultList mCid

  mapTextDocIds <- getNodesByNgramsOnlyUser uCid
                                            [userListId, masterListId]
                                            NgramsTerms
                                            selectedTerms

  let
    mapGroups   = Map.fromList
                $ map (\g -> (g ^. gt_stem, g))
                $ groupedMonoHead <> groupedMultHead

    -- grouping with Set NodeId
    contextsAdded = foldl' (\mapGroups' k ->
                                    let k' = groupWith groupParams k in
                                        case Map.lookup k' mapGroups'  of
                                          Nothing -> mapGroups'
                                          Just g  -> case Map.lookup k mapTextDocIds of
                                            Nothing -> mapGroups'
                                            Just ns -> Map.insert k' (over gt_nodes (Set.union ns) g) mapGroups'
                           )
                  mapGroups
                  $ Map.keys mapTextDocIds

    -- compute cooccurrences
    mapCooc = Map.filter (>2)
            $ Map.fromList [ ((t1, t2), Set.size $ Set.intersection s1 s2)
                           | (t1, s1) <- mapStemNodeIds
                           , (t2, s2) <- mapStemNodeIds
                           --, t1 >= t2 -- permute byAxis diag  -- since matrix symmetric
                           ]
      where
        mapStemNodeIds = Map.toList $ Map.map (_gt_nodes) contextsAdded
  -- printDebug "mapCooc" mapCooc

  let
    -- computing scores
    mapScores f = Map.fromList
                $ map (\(Scored t g s') -> (t, f (g,s')))
                $ normalizeGlobal
                $ map normalizeLocal
                $ scored' mapCooc

    groupsWithScores = catMaybes
                     $ map (\(stem, g)
                             -> case Map.lookup stem mapScores' of
                                 Nothing -> Nothing
                                 Just s'  -> Just $ g { _gt_score = s'}
                            ) $ Map.toList contextsAdded
      where
        mapScores' = mapScores identity
        -- adapt2 TOCHECK with DC
  -- printDebug "groupsWithScores" groupsWithScores
  let
    -- sort / partition / split
      -- filter mono/multi again
    (monoScored, multScored) = List.partition (\g -> _gt_size g < 2) groupsWithScores
      -- filter with max score
    partitionWithMaxScore = List.partition (\g -> let (s1,s2) = viewScore g in s1 > s2 )

    (monoScoredIncl, monoScoredExcl) = partitionWithMaxScore monoScored
    (multScoredIncl, multScoredExcl) = partitionWithMaxScore multScored

      -- splitAt
  let
    listSizeLocal = 1000 :: Double -- use % of list if to big, or Int if to small
    inclSize = 0.4  :: Double
    exclSize = 1 - inclSize
    splitAt' n' = List.splitAt (round $ n' * listSizeLocal)

    (monoScoredInclHead, monoScoredInclTail) = splitAt' (monoSize * inclSize / 2) $ List.sortOn (Down . viewScore) monoScoredIncl
    (monoScoredExclHead, monoScoredExclTail) = splitAt' (monoSize * inclSize / 2) $ List.sortOn (Down . viewScore) monoScoredExcl

    (multScoredInclHead, multScoredInclTail) = splitAt' (multSize * exclSize / 2) $ List.sortOn (Down . viewScore) multScoredIncl
    (multScoredExclHead, multScoredExclTail) = splitAt' (multSize * exclSize / 2) $ List.sortOn (Down . viewScore) multScoredExcl


    -- Final Step building the Typed list
    termListHead = maps <> cands
      where
        maps = setListType (Just MapTerm)
            <$> monoScoredInclHead
             <> monoScoredExclHead
             <> multScoredInclHead
             <> multScoredExclHead

        cands = setListType (Just CandidateTerm)
             <$> monoScoredInclTail
              <> monoScoredExclTail
              <> multScoredInclTail
              <> multScoredExclTail

    termListTail = map (setListType (Just CandidateTerm)) ( groupedMonoTail <> groupedMultTail)

--  printDebug "monoScoredInclHead" monoScoredInclHead
--  printDebug "monoScoredExclHead" monoScoredExclTail
--  printDebug "multScoredInclHead" multScoredInclHead
--  printDebug "multScoredExclTail" multScoredExclTail

  let result = Map.unionsWith (<>)
       [ Map.fromList [( NgramsTerms, (List.concat $ map toNgramsElement $ termListHead)
                                   <> (List.concat $ map toNgramsElement $ termListTail)
                                   <> (List.concat $ map toNgramsElement $ stopTerms)
                      )]
       ]
  -- printDebug "\n result \n" r
  pure result



toGargList :: Maybe ListType -> b -> (Maybe ListType, b)
toGargList l n = (l,n)


isStopTerm :: StopSize -> Text -> Bool
isStopTerm (StopSize n) x = Text.length x < n || any isStopChar (Text.unpack x)
  where
    isStopChar c = not (c `elem` ("- /()%" :: [Char]) || Char.isAlpha c)

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