{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Phylomemy.TemporalMatchingSpec where

import Control.Monad (forM_)
import Data.Function (($), (&), (.))
import Data.Functor ((<&>))
import Data.GenValidity
import Data.GenValidity.Map ()
import Data.GenValidity.Sequence ()
import Data.GenValidity.Set ()
import Data.GenValidity.Text ()
import Data.GenValidity.Time ()
import Data.Int (Int)
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Maybe (fromJust)
import Data.Ord (Ord)
import Data.Sequence qualified as Seq
import Data.Text.Short (ShortText)
import Data.Text.Short qualified as ShortText
import Data.Time (UTCTime)
import Data.Validity.Map ()
import Data.Validity.Set ()
import Data.Validity.Text ()
import GHC.IsList (toList)
import Logic
import Numeric.Natural (Natural)
import System.FilePath ((<.>))
import Test.Syd
import Test.Syd.Validity
import Text.Show (Show (..))
import Prelude (Integral (..), Num (..))

import Phylomemy
import Phylomemy.IndexationSpec (Pos (..), Rang)

import Utils

rangeToDocs0 :: Pos :-> Seq.Seq (Document Pos)
rangeToDocs0 =
  Map.fromList
    [ ( Pos rangeIndex
      , Seq.fromList
          [ Document
            { documentPosition = Pos (2 * rangeIndex + 3 * docIndex)
            , documentRoots = Map.fromList [(r, ()) | r <- roots]
            }
          | roots <- docs
          | docIndex <- [1 ..]
          ]
      )
    | docs <-
        [ [["a", "b", "c"], ["a", "d", "e"], ["e", "f", "g"]]
        , [["a", "b"], ["d", "f"]]
        , [["f"], ["d", "f"], ["f", "g", "a"]]
        , [["b", "c", "e"], ["a", "d", "e"], ["a", "b", "c"]]
        , [["d", "f", "g"], ["b", "f"], ["a", "c", "d"], ["a", "f"]]
        , [["c", "d", "g"], ["b", "c", "g"], ["a", "b", "c"], ["e", "g"]]
        ]
    | rangeIndex <- [1 ..]
    ]

{-
rangeToDocs0 :: Pos :-> Seq.Seq (Document Pos)
rangeToDocs0 =
  Map.fromListWith
    (<>)
    [ (Pos (pos - (pos `rem` 2)), Seq.singleton doc)
    | doc <- docs0 & toList
    , let Pos pos = documentPosition doc
    ]
-}

spec :: Spec
spec = do
  letName rangeToDocs0 $ \rangeToDocs ->
    letName ["a", "b", "c", "d", "e", "f", "g"] $ \roots ->
      forM_ ([1 .. 1] :: [Int]) \minSupp ->
        forM_ ([2 .. 2] :: [Int]) \minSize -> do
          let clusters =
                clusterize
                  roots
                  (assertStrictlyPositive minSupp)
                  (assertStrictlyPositive minSize)
                  rangeToDocs
          let phy = phylomemy jaccardSimilarity (clusters <&> unName)
          let weights = phylomemyWeights phy
          describe "phylomemyWeights" do
            goldenShow ("docs=docs0" <.> "minSupp=" <> show minSupp <.> "minSize=" <> show minSize) weights
          describe "phylomemyDOT" do
            forM_ weights \minWeight ->
              goldenBuilder ("docs=docs0" <.> "minSupp=" <> show minSupp <.> "minSize=" <> show minSize <.> "minWeight=" <> show minWeight) $
                phylomemyDOT $
                  phylomemyRaise minWeight phy