{-# LANGUAGE OverloadedStrings #-}

module Analysis
  ( analyzeStackYaml
  , analyzeAllStackYamls
  ) where

import Prelude hiding (min, span)

import Data.Functor ((<&>))
import Data.List (maximumBy)
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes)
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Text qualified as T
import Text.Printf (printf)

import Types (Action(..), SnapshotDB(..), LTSVersion(..), NightlyVersion(..), GHCVersion(..), Snapshot(..))
import StackYaml (parseStackYaml, findStackYamlFiles, getSymlinkMap)

-- | Analyze a single stack.yaml file
analyzeStackYaml :: SnapshotDB -> Map.Map FilePath FilePath -> FilePath -> IO (Maybe Action)
analyzeStackYaml :: SnapshotDB -> Map [Char] [Char] -> [Char] -> IO (Maybe Action)
analyzeStackYaml SnapshotDB
db Map [Char] [Char]
symlinkMap [Char]
file = do
  -- Check if this file is a symlink to another stack*.yaml file in our list
  let symlinkTarget :: Maybe [Char]
symlinkTarget = [Char] -> Map [Char] [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
file Map [Char] [Char]
symlinkMap

  [Char] -> IO (Maybe (Text, Bool, (Int, Int)))
parseStackYaml [Char]
file IO (Maybe (Text, Bool, (Int, Int)))
-> (Maybe (Text, Bool, (Int, Int)) -> Maybe Action)
-> IO (Maybe Action)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Maybe (Text, Bool, (Int, Int))
Nothing -> Maybe Action
forall a. Maybe a
Nothing
    Just (Text
oldSnap, Bool
isResolver, (Int, Int)
span) -> do
      let newSnap :: Maybe Text
newSnap = SnapshotDB -> Text -> Maybe Text
determineNewSnapshot SnapshotDB
db Text
oldSnap
      Action -> Maybe Action
forall a. a -> Maybe a
Just (Action -> Maybe Action) -> Action -> Maybe Action
forall a b. (a -> b) -> a -> b
$ [Char]
-> Text
-> Maybe Text
-> Bool
-> (Int, Int)
-> Maybe [Char]
-> Action
Action [Char]
file Text
oldSnap Maybe Text
newSnap Bool
isResolver (Int, Int)
span Maybe [Char]
symlinkTarget

-- | Analyze all stack*.yaml files in the current directory
analyzeAllStackYamls :: SnapshotDB -> IO [Action]
analyzeAllStackYamls :: SnapshotDB -> IO [Action]
analyzeAllStackYamls SnapshotDB
db = do
  files <- IO [[Char]]
findStackYamlFiles
  symlinkMap <- getSymlinkMap files
  results <- mapM (analyzeStackYaml db symlinkMap) files
  return $ catMaybes results

-- | Determine the new snapshot for a given old snapshot
determineNewSnapshot :: SnapshotDB -> Text -> Maybe Text
determineNewSnapshot :: SnapshotDB -> Text -> Maybe Text
determineNewSnapshot SnapshotDB
db Text
oldSnap
  | Text -> Text -> Bool
T.isPrefixOf Text
"lts-" Text
oldSnap = SnapshotDB -> Text -> Maybe Text
determineLTSBump SnapshotDB
db Text
oldSnap
  | Text -> Text -> Bool
T.isPrefixOf Text
"nightly-" Text
oldSnap = SnapshotDB -> Text -> Maybe Text
determineNightlyBump SnapshotDB
db Text
oldSnap
  | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

-- | Determine bump for LTS snapshot
determineLTSBump :: SnapshotDB -> Text -> Maybe Text
determineLTSBump :: SnapshotDB -> Text -> Maybe Text
determineLTSBump SnapshotDB
db Text
oldSnap = do
  oldVersion <- Text -> Maybe LTSVersion
parseLTSSnapshot Text
oldSnap
  -- Find the latest LTS with the same major version
  let sameMajor = ((LTSVersion, GHCVersion) -> Bool)
-> [(LTSVersion, GHCVersion)] -> [(LTSVersion, GHCVersion)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(LTSVersion Int
maj Int
_, GHCVersion
_) -> Int
maj Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== LTSVersion -> Int
ltsMajor LTSVersion
oldVersion) ([(LTSVersion, GHCVersion)] -> [(LTSVersion, GHCVersion)])
-> [(LTSVersion, GHCVersion)] -> [(LTSVersion, GHCVersion)]
forall a b. (a -> b) -> a -> b
$ Map LTSVersion GHCVersion -> [(LTSVersion, GHCVersion)]
forall k a. Map k a -> [(k, a)]
Map.toList (SnapshotDB -> Map LTSVersion GHCVersion
dbLTS SnapshotDB
db)
  if null sameMajor
    then Nothing
    else do
      let (latestVersion, _) = maximumBy (comparing fst) sameMajor
      let newSnap = Snapshot -> Text
formatSnapshot (LTSVersion -> Snapshot
LTS LTSVersion
latestVersion)
      if newSnap == oldSnap
        then Nothing  -- Already up to date
        else Just newSnap

-- | Determine bump for nightly snapshot
determineNightlyBump :: SnapshotDB -> Text -> Maybe Text
determineNightlyBump :: SnapshotDB -> Text -> Maybe Text
determineNightlyBump SnapshotDB
db Text
oldSnap = do
  oldVersion <- Text -> Maybe NightlyVersion
parseNightlySnapshot Text
oldSnap
  oldGHC <- Map.lookup oldVersion (dbNightly db)
  -- Get GHC major version (e.g., (9,6) from GHCVersion 9 6 1)
  let ghcMajor = GHCVersion -> (Int, Int)
getGHCMajor GHCVersion
oldGHC
  -- Find if there's an LTS for this GHC major version
  let ltsForGHC = ((LTSVersion, GHCVersion) -> Bool)
-> [(LTSVersion, GHCVersion)] -> [(LTSVersion, GHCVersion)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(LTSVersion
_, GHCVersion
ghc) -> GHCVersion -> (Int, Int)
getGHCMajor GHCVersion
ghc (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int)
ghcMajor) ([(LTSVersion, GHCVersion)] -> [(LTSVersion, GHCVersion)])
-> [(LTSVersion, GHCVersion)] -> [(LTSVersion, GHCVersion)]
forall a b. (a -> b) -> a -> b
$ Map LTSVersion GHCVersion -> [(LTSVersion, GHCVersion)]
forall k a. Map k a -> [(k, a)]
Map.toList (SnapshotDB -> Map LTSVersion GHCVersion
dbLTS SnapshotDB
db)
  if not (null ltsForGHC)
    then do
      -- Bump to latest LTS for this GHC major
      let (latestLTS, _) = maximumBy (comparing fst) ltsForGHC
      return $ formatSnapshot (LTS latestLTS)
    else do
      -- Bump to latest nightly for this GHC major
      let nightliesForGHC = ((NightlyVersion, GHCVersion) -> Bool)
-> [(NightlyVersion, GHCVersion)] -> [(NightlyVersion, GHCVersion)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(NightlyVersion
_, GHCVersion
ghc) -> GHCVersion -> (Int, Int)
getGHCMajor GHCVersion
ghc (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int)
ghcMajor) ([(NightlyVersion, GHCVersion)] -> [(NightlyVersion, GHCVersion)])
-> [(NightlyVersion, GHCVersion)] -> [(NightlyVersion, GHCVersion)]
forall a b. (a -> b) -> a -> b
$ Map NightlyVersion GHCVersion -> [(NightlyVersion, GHCVersion)]
forall k a. Map k a -> [(k, a)]
Map.toList (SnapshotDB -> Map NightlyVersion GHCVersion
dbNightly SnapshotDB
db)
      if null nightliesForGHC
        then Nothing
        else do
          let (latestNightly, _) = maximumBy (comparing fst) nightliesForGHC
          let newSnap = Snapshot -> Text
formatSnapshot (NightlyVersion -> Snapshot
Nightly NightlyVersion
latestNightly)
          if newSnap == oldSnap
            then Nothing
            else Just newSnap

-- | Get GHC major version from full version (e.g., (9,6) from GHCVersion 9 6 1)
getGHCMajor :: GHCVersion -> (Int, Int)
getGHCMajor :: GHCVersion -> (Int, Int)
getGHCMajor (GHCVersion Int
maj1 Int
maj2 Int
_) = (Int
maj1, Int
maj2)

-- | Parse LTS snapshot string
parseLTSSnapshot :: Text -> Maybe LTSVersion
parseLTSSnapshot :: Text -> Maybe LTSVersion
parseLTSSnapshot Text
snap =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." (Int -> Text -> Text
T.drop Int
4 Text
snap) of  -- Remove "lts-"
    [Text
majStr, Text
minStr] ->
      case (ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
majStr, ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
minStr) of
        ([(Int
maj, [Char]
"")], [(Int
min, [Char]
"")]) -> LTSVersion -> Maybe LTSVersion
forall a. a -> Maybe a
Just (LTSVersion -> Maybe LTSVersion) -> LTSVersion -> Maybe LTSVersion
forall a b. (a -> b) -> a -> b
$ Int -> Int -> LTSVersion
LTSVersion Int
maj Int
min
        ([(Int, [Char])], [(Int, [Char])])
_ -> Maybe LTSVersion
forall a. Maybe a
Nothing
    [Text]
_ -> Maybe LTSVersion
forall a. Maybe a
Nothing

-- | Parse nightly snapshot string
parseNightlySnapshot :: Text -> Maybe NightlyVersion
parseNightlySnapshot :: Text -> Maybe NightlyVersion
parseNightlySnapshot Text
snap =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"-" (Int -> Text -> Text
T.drop Int
8 Text
snap) of  -- Remove "nightly-"
    [Text
yearStr, Text
monthStr, Text
dayStr] ->
      case (ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
yearStr, ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
monthStr, ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
dayStr) of
        ([(Int
year, [Char]
"")], [(Int
month, [Char]
"")], [(Int
day, [Char]
"")]) -> NightlyVersion -> Maybe NightlyVersion
forall a. a -> Maybe a
Just (NightlyVersion -> Maybe NightlyVersion)
-> NightlyVersion -> Maybe NightlyVersion
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> NightlyVersion
NightlyVersion Int
year Int
month Int
day
        ([(Int, [Char])], [(Int, [Char])], [(Int, [Char])])
_ -> Maybe NightlyVersion
forall a. Maybe a
Nothing
    [Text]
_ -> Maybe NightlyVersion
forall a. Maybe a
Nothing

-- | Format a snapshot as a string
formatSnapshot :: Snapshot -> Text
formatSnapshot :: Snapshot -> Text
formatSnapshot (LTS (LTSVersion Int
maj Int
min)) =
  Text
"lts-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maj) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
min)
formatSnapshot (Nightly (NightlyVersion Int
year Int
month Int
day)) =
  [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"nightly-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Int -> Int -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%d-%02d-%02d" Int
year Int
month Int
day