#!/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

main = do
    let minSupp = assertStrictlyPositive 1
    let minSize = assertStrictlyPositive 2

    letName rangeToDocs0 $ \rangeToDocs ->
        letName ["a", "b", "c", "d", "e", "f", "g"] $ \roots -> do
            let clusters =
                    Phylo.clusterize roots minSupp minSize rangeToDocs

            let msf :: Phylo.MaximalSpanningForest Pos Phylo.Cluster =
                    Phylo.maximalSpanningForest Phylo.similarityJaccard (unName <$> clusters)
            let phylomemy :: Phylo.MaximalSpanningForest Pos Phylo.Cluster =
                    let Just lambda = probability 0.3
                     in letName (Phylo.predictionMeasureF lambda) $ \predMeasure ->
                            Phylo.msfSplit predMeasure roots msf
            let dot = Phylo.dotMaximalSpanningForest phylomemy

            pPrint ("Number of maximal spanning trees", length phylomemy)
            Sys.withFile "phylomemy.dot" Sys.WriteMode (`BS.hPutBuilder` dot)
            Sys.callProcess "xdot" ["phylomemy.dot"]

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 ..]
        ]

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

newtype Pos = Pos Int deriving (Eq, Ord, Show, Num)
instance Phylo.ShowHuman Pos where
    showHuman (Pos x) = show x