#!/usr/bin/env -S nix -L shell .#ghc .#ghcid .#xdot --command ghcid --test :main
-- Alternatively: #!/usr/bin/env -S nix -L shell .#ghc .#xdot --command runghc
-- SPDX-FileCopyrightText: 2024 Jane Doe <jane@example.org>
-- SPDX-License-Identifier: CC0-1.0

{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}

import Control.Concurrent.Async qualified as Async
import Data.ByteString.Builder qualified as BS
import Data.Either (fromRight)
import Data.Map.Strict qualified as Map
import Data.Sequence qualified as Seq
import Logic
import Logic.Theory.Arithmetic
import Logic.Theory.Ord
import Numeric.Probability
import Phylomemy qualified as Phylo
import System.IO qualified as Sys
import System.Process qualified as Sys
import Text.Pretty.Simple
-- import Turtle
-- import GHC.Conc

assertStrictlyPositive :: Ord a => Zeroable a => a -> () ::: a / () > Zero
assertStrictlyPositive i = unitName i Logic./ fromRight undefined (prove (unitName i Logic.Theory.Ord.> zero))

main = do
  let minSupp = 1
  let minSize = 2

  let clusters =
        Logic.letName rangeToDocs0 $ \rangeToDocs ->
        Logic.letName ["a", "b", "c", "d", "e", "F", "g"] $ \roots ->
        Phylo.clusterize roots (assertStrictlyPositive minSupp) (assertStrictlyPositive minSize) rangeToDocs

  let phy = Phylo.phylomemy Phylo.jaccardSimilarity (unName <$> clusters)
  let dot = Phylo.phylomemyDOT phy
  let msf :: Map.Map (Pos, Phylo.Cluster) (Phylo.MST Pos)
        = Phylo.branchesMSF phy

  pPrint ("msf", Map.size msf)
  Sys.withFile "phylomemy.dot" Sys.WriteMode (`BS.hPutBuilder` dot)
  Sys.callProcess "xdot" ["phylomemy.dot"]

phy :: Phylo.PhylomemyDownstream Int
phy = [
  ]

newtype Pos = Pos Int deriving (Eq, Ord, Show, Num)

rangeToDocs0 :: Pos Phylo.:-> Seq.Seq (Phylo.Document Pos)
rangeToDocs0 =
  Map.fromList
    [ ( Pos rangeIndex
      , Seq.fromList
          [ Phylo.Document
            { Phylo.documentPosition = Pos (2 * rangeIndex + 3 * docIndex)
            , Phylo.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 ..]
    ]