{-# LANGUAGE OverloadedStrings #-}

module CSV
  ( generateCSVs
  , loadSnapshotDB
  , ensureCSVFiles
  ) where

import Prelude hiding (lines, min)

import Control.Monad (unless)
import Data.List (sortBy, sortOn)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import System.Directory (listDirectory, doesFileExist, createDirectoryIfMissing)
import System.FilePath ((</>), takeExtension)
import Data.Yaml qualified as Yaml
import Data.Yaml ((.:))
import Data.Aeson qualified as Aeson
import Text.Printf (printf)
import Types (LTSVersion(..), NightlyVersion(..), GHCVersion(..), Snapshot(..), SnapshotDB(..))
import XDG (getStateDir)
import System.IO (stderr)
import Paths_stacker (getDataDir)
import System.Directory qualified as Dir

-- Helper functions for parsing
parseGHCVersionText :: Text -> Maybe GHCVersion
parseGHCVersionText :: Text -> Maybe GHCVersion
parseGHCVersionText Text
txt =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
txt of
    [Text
maj1Str, Text
maj2Str, Text
minStr] ->
      case (ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
maj1Str, ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
maj2Str, ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
minStr) of
        ([(Int
maj1, String
"")], [(Int
maj2, String
"")], [(Int
minV, String
"")]) -> GHCVersion -> Maybe GHCVersion
forall a. a -> Maybe a
Just (GHCVersion -> Maybe GHCVersion) -> GHCVersion -> Maybe GHCVersion
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> GHCVersion
GHCVersion Int
maj1 Int
maj2 Int
minV
        ([(Int, String)], [(Int, String)], [(Int, String)])
_ -> Maybe GHCVersion
forall a. Maybe a
Nothing
    [Text]
_ -> Maybe GHCVersion
forall a. Maybe a
Nothing

parseNightlyVersionText :: Text -> Maybe NightlyVersion
parseNightlyVersionText :: Text -> Maybe NightlyVersion
parseNightlyVersionText Text
txt =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"-" Text
txt of
    [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 -> String
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 -> String
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 -> String
T.unpack Text
dayStr) of
        ([(Int
year, String
"")], [(Int
month, String
"")], [(Int
day, String
"")]) -> 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, String)], [(Int, String)], [(Int, String)])
_ -> Maybe NightlyVersion
forall a. Maybe a
Nothing
    [Text]
_ -> Maybe NightlyVersion
forall a. Maybe a
Nothing

-- Helper functions for formatting
formatGHCVersion :: GHCVersion -> Text
formatGHCVersion :: GHCVersion -> Text
formatGHCVersion (GHCVersion Int
maj1 Int
maj2 Int
minV) =
  String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
maj1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maj2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
minV

formatNightlyVersion :: NightlyVersion -> Text
formatNightlyVersion :: NightlyVersion -> Text
formatNightlyVersion (NightlyVersion Int
year Int
month Int
day) =
  String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d-%02d-%02d" Int
year Int
month Int
day

-- | Ensure CSV files exist in state directory, copying from data directory if needed
ensureCSVFiles :: IO ()
ensureCSVFiles :: IO ()
ensureCSVFiles = do
  stateDir <- IO String
getStateDir
  createDirectoryIfMissing True stateDir

  dataDir <- getDataDir

  -- Check if any CSV file is missing
  ghcExists <- doesFileExist (stateDir </> "ghc.csv")
  ltsExists <- doesFileExist (stateDir </> "lts.csv")
  nightlyExists <- doesFileExist (stateDir </> "nightly.csv")

  unless (ghcExists && ltsExists && nightlyExists) $ do
    TIO.hPutStrLn stderr "Copying CSV files from data directory..."
    -- Copy all three CSV files from data directory
    Dir.copyFile (dataDir </> "ghc.csv") (stateDir </> "ghc.csv")
    Dir.copyFile (dataDir </> "lts.csv") (stateDir </> "lts.csv")
    Dir.copyFile (dataDir </> "nightly.csv") (stateDir </> "nightly.csv")

-- | Generate CSV files from the stackage-snapshots repository
generateCSVs :: FilePath -> IO ()
generateCSVs :: String -> IO ()
generateCSVs String
repoPath = do
  stateDir <- IO String
getStateDir
  createDirectoryIfMissing True stateDir

  TIO.hPutStrLn stderr $ "Processing snapshot database.  This might take a couple of minutes..."

  -- Process LTS snapshots
  TIO.hPutStrLn stderr $ "Processing LTSs..."
  ltsMap <- processLTSSnapshots (repoPath </> "lts")
  writeLTSCSV (stateDir </> "lts.csv") ltsMap

  -- Process nightly snapshots
  TIO.hPutStrLn stderr $ "Processing nightlys..."
  nightlyMap <- processNightlySnapshots (repoPath </> "nightly")
  writeNightlyCSV (stateDir </> "nightly.csv") nightlyMap

  -- Generate GHC version map
  TIO.hPutStrLn stderr $ "Computing latest snapshot per GHC version..."
  let ghcMap = [(LTSVersion, GHCVersion)]
-> [(NightlyVersion, GHCVersion)] -> Map GHCVersion Snapshot
generateGHCMap [(LTSVersion, GHCVersion)]
ltsMap [(NightlyVersion, GHCVersion)]
nightlyMap
  writeGHCCSV (stateDir </> "ghc.csv") ghcMap

  TIO.hPutStrLn stderr $ "Done processing snapshot database."

-- | Process LTS snapshots (structure: lts/major/minor.yaml)
processLTSSnapshots :: FilePath -> IO [(LTSVersion, GHCVersion)]
processLTSSnapshots :: String -> IO [(LTSVersion, GHCVersion)]
processLTSSnapshots String
ltsDir = do
  majorDirs <- String -> IO [String]
listDirectory String
ltsDir
  let sortedMajors = (String -> Int) -> [String] -> [String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\String
s -> String -> Int
forall a. Read a => String -> a
read String
s :: Int) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"0123456789" :: String))) [String]
majorDirs
  concat <$> mapM (processMajor ltsDir) sortedMajors
  where
    processMajor :: String -> String -> IO [(LTSVersion, GHCVersion)]
processMajor String
dir String
majorStr = do
      case ReadS Int
forall a. Read a => ReadS a
reads String
majorStr of
        [(Int
major, String
"")] -> do
          let majorPath :: String
majorPath = String
dir String -> String -> String
</> String
majorStr
          minorFiles <- String -> IO [String]
listDirectory String
majorPath
          let sortedMinors = (String -> Int) -> [String] -> [String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\String
s -> String -> Int
forall a. Read a => String -> a
read (Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) String
s) :: Int) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                             (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> String -> String
takeExtension String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".yaml") [String]
minorFiles
          mapM (processMinor majorPath major) sortedMinors
        [(Int, String)]
_ -> [(LTSVersion, GHCVersion)] -> IO [(LTSVersion, GHCVersion)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    processMinor :: String -> Int -> String -> IO (LTSVersion, GHCVersion)
processMinor String
dir Int
major String
fname
      | String -> String
takeExtension String
fname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".yaml" = do
          let minorStr :: String
minorStr = Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fname Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) String
fname
          case ReadS Int
forall a. Read a => ReadS a
reads String
minorStr of
            [(Int
minor, String
"")] -> do
              ghc <- String -> IO GHCVersion
extractGHCVersion (String
dir String -> String -> String
</> String
fname)
              return (LTSVersion major minor, ghc)
            [(Int, String)]
_ -> String -> IO (LTSVersion, GHCVersion)
forall a. HasCallStack => String -> a
error (String -> IO (LTSVersion, GHCVersion))
-> String -> IO (LTSVersion, GHCVersion)
forall a b. (a -> b) -> a -> b
$ String
"Invalid minor version format in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname String -> String -> String
forall a. [a] -> [a] -> [a]
++
                        String
": expected integer, got '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
minorStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
      | Bool
otherwise = String -> IO (LTSVersion, GHCVersion)
forall a. HasCallStack => String -> a
error (String -> IO (LTSVersion, GHCVersion))
-> String -> IO (LTSVersion, GHCVersion)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected file in LTS directory: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           String
" (expected .yaml extension)"

-- | Process nightly snapshots (structure: nightly/year/month/day.yaml)
processNightlySnapshots :: FilePath -> IO [(NightlyVersion, GHCVersion)]
processNightlySnapshots :: String -> IO [(NightlyVersion, GHCVersion)]
processNightlySnapshots String
nightlyDir = do
  yearDirs <- String -> IO [String]
listDirectory String
nightlyDir
  let sortedYears = (String -> Int) -> [String] -> [String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\String
s -> String -> Int
forall a. Read a => String -> a
read String
s :: Int) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"0123456789" :: String))) [String]
yearDirs
  concat <$> mapM (processYear nightlyDir) sortedYears
  where
    processYear :: String -> String -> IO [(NightlyVersion, GHCVersion)]
processYear String
dir String
yearStr = do
      case ReadS Int
forall a. Read a => ReadS a
reads String
yearStr of
        [(Int
year, String
"")] -> do
          let yearPath :: String
yearPath = String
dir String -> String -> String
</> String
yearStr
          monthDirs <- String -> IO [String]
listDirectory String
yearPath
          let sortedMonths = (String -> Int) -> [String] -> [String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\String
s -> String -> Int
forall a. Read a => String -> a
read String
s :: Int) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"0123456789" :: String))) [String]
monthDirs
          months <- mapM (processMonth yearPath year) sortedMonths
          return $ concat months
        [(Int, String)]
_ -> [(NightlyVersion, GHCVersion)] -> IO [(NightlyVersion, GHCVersion)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    processMonth :: String -> Int -> String -> IO [(NightlyVersion, GHCVersion)]
processMonth String
dir Int
year String
monthStr = do
      case ReadS Int
forall a. Read a => ReadS a
reads String
monthStr of
        [(Int
month, String
"")] -> do
          let monthPath :: String
monthPath = String
dir String -> String -> String
</> String
monthStr
          dayFiles <- String -> IO [String]
listDirectory String
monthPath
          let sortedDays = (String -> Int) -> [String] -> [String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\String
s -> String -> Int
forall a. Read a => String -> a
read (Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) String
s) :: Int) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                           (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
s -> String -> String
takeExtension String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".yaml") [String]
dayFiles
          mapM (processDay monthPath year month) sortedDays
        [(Int, String)]
_ -> [(NightlyVersion, GHCVersion)] -> IO [(NightlyVersion, GHCVersion)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    processDay :: String -> Int -> Int -> String -> IO (NightlyVersion, GHCVersion)
processDay String
dir Int
year Int
month String
fname
      | String -> String
takeExtension String
fname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".yaml" = do
          case ReadS Int
forall a. Read a => ReadS a
reads ReadS Int -> ReadS Int
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fname Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) String
fname of
            [(Int
day, String
"")] -> do
              ghc <- String -> IO GHCVersion
extractGHCVersion (String
dir String -> String -> String
</> String
fname)
              return (NightlyVersion year month day, ghc)
            [(Int, String)]
_ -> String -> IO (NightlyVersion, GHCVersion)
forall a. HasCallStack => String -> a
error (String -> IO (NightlyVersion, GHCVersion))
-> String -> IO (NightlyVersion, GHCVersion)
forall a b. (a -> b) -> a -> b
$ String
"Invalid day in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname
      | Bool
otherwise = String -> IO (NightlyVersion, GHCVersion)
forall a. HasCallStack => String -> a
error (String -> IO (NightlyVersion, GHCVersion))
-> String -> IO (NightlyVersion, GHCVersion)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected file in nightly directory: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fname String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           String
" (expected .yaml extension)"

-- | Extract GHC version from a snapshot YAML file
extractGHCVersion :: FilePath -> IO GHCVersion
extractGHCVersion :: String -> IO GHCVersion
extractGHCVersion String
file = do
  result <- String -> IO (Either ParseException Value)
forall a. FromJSON a => String -> IO (Either ParseException a)
Yaml.decodeFileEither String
file
  case result of
    Left ParseException
err -> String -> IO GHCVersion
forall a. HasCallStack => String -> a
error (String -> IO GHCVersion) -> String -> IO GHCVersion
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseException -> String
forall a. Show a => a -> String
show ParseException
err
    Right (Aeson.Object Object
obj) ->
      -- Try new format first (nested under resolver)
      case (Object -> Parser Value) -> Object -> Maybe Value
forall a b. (a -> Parser b) -> a -> Maybe b
Yaml.parseMaybe (Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"resolver") Object
obj of
        Just (Aeson.Object Object
resolverObj) ->
          case (Object -> Parser Value) -> Object -> Maybe Value
forall a b. (a -> Parser b) -> a -> Maybe b
Yaml.parseMaybe (Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"compiler") Object
resolverObj of
            Just (Aeson.String Text
compiler) ->
              Text -> IO GHCVersion
forall {m :: * -> *}. Monad m => Text -> m GHCVersion
parseCompiler Text
compiler
            Maybe Value
_ -> String -> IO GHCVersion
forall a. HasCallStack => String -> a
error (String -> IO GHCVersion) -> String -> IO GHCVersion
forall a b. (a -> b) -> a -> b
$ String
"No compiler field in resolver in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
        Maybe Value
_ ->
          -- Try old format (compiler at top level)
          case (Object -> Parser Value) -> Object -> Maybe Value
forall a b. (a -> Parser b) -> a -> Maybe b
Yaml.parseMaybe (Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"compiler") Object
obj of
            Just (Aeson.String Text
compiler) ->
              Text -> IO GHCVersion
forall {m :: * -> *}. Monad m => Text -> m GHCVersion
parseCompiler Text
compiler
            Maybe Value
_ -> String -> IO GHCVersion
forall a. HasCallStack => String -> a
error (String -> IO GHCVersion) -> String -> IO GHCVersion
forall a b. (a -> b) -> a -> b
$ String
"No compiler field in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
    Either ParseException Value
_ -> String -> IO GHCVersion
forall a. HasCallStack => String -> a
error (String -> IO GHCVersion) -> String -> IO GHCVersion
forall a b. (a -> b) -> a -> b
$ String
"Invalid YAML in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
  where
    parseCompiler :: Text -> m GHCVersion
parseCompiler Text
compiler =
      case Text -> Maybe GHCVersion
parseGHCVersionText (Int -> Text -> Text
T.drop Int
4 Text
compiler) of
        Just GHCVersion
ghc -> GHCVersion -> m GHCVersion
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return GHCVersion
ghc
        Maybe GHCVersion
Nothing -> String -> m GHCVersion
forall a. HasCallStack => String -> a
error (String -> m GHCVersion) -> String -> m GHCVersion
forall a b. (a -> b) -> a -> b
$ String
"Invalid GHC version format in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
compiler

-- | Write LTS CSV file
writeLTSCSV :: FilePath -> [(LTSVersion, GHCVersion)] -> IO ()
writeLTSCSV :: String -> [(LTSVersion, GHCVersion)] -> IO ()
writeLTSCSV String
path [(LTSVersion, GHCVersion)]
entries = do
  let sorted :: [(LTSVersion, GHCVersion)]
sorted = ((LTSVersion, GHCVersion) -> (LTSVersion, GHCVersion) -> Ordering)
-> [(LTSVersion, GHCVersion)] -> [(LTSVersion, GHCVersion)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((LTSVersion, GHCVersion) -> LTSVersion)
-> (LTSVersion, GHCVersion) -> (LTSVersion, GHCVersion) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (LTSVersion, GHCVersion) -> LTSVersion
forall a b. (a, b) -> a
fst) [(LTSVersion, GHCVersion)]
entries
  let lines :: [Text]
lines = ((LTSVersion, GHCVersion) -> Text)
-> [(LTSVersion, GHCVersion)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (LTSVersion, GHCVersion) -> Text
formatLTSEntry [(LTSVersion, GHCVersion)]
sorted
  String -> Text -> IO ()
TIO.writeFile String
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
lines
  where
    formatLTSEntry :: (LTSVersion, GHCVersion) -> Text
formatLTSEntry (LTSVersion Int
maj Int
min, GHCVersion
ghc) =
      String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
maj) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
min) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GHCVersion -> Text
formatGHCVersion GHCVersion
ghc

-- | Write nightly CSV file
writeNightlyCSV :: FilePath -> [(NightlyVersion, GHCVersion)] -> IO ()
writeNightlyCSV :: String -> [(NightlyVersion, GHCVersion)] -> IO ()
writeNightlyCSV String
path [(NightlyVersion, GHCVersion)]
entries = do
  let sorted :: [(NightlyVersion, GHCVersion)]
sorted = ((NightlyVersion, GHCVersion)
 -> (NightlyVersion, GHCVersion) -> Ordering)
-> [(NightlyVersion, GHCVersion)] -> [(NightlyVersion, GHCVersion)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((NightlyVersion, GHCVersion) -> NightlyVersion)
-> (NightlyVersion, GHCVersion)
-> (NightlyVersion, GHCVersion)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (NightlyVersion, GHCVersion) -> NightlyVersion
forall a b. (a, b) -> a
fst) [(NightlyVersion, GHCVersion)]
entries
  let lines :: [Text]
lines = ((NightlyVersion, GHCVersion) -> Text)
-> [(NightlyVersion, GHCVersion)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (NightlyVersion, GHCVersion) -> Text
formatNightlyEntry [(NightlyVersion, GHCVersion)]
sorted
  String -> Text -> IO ()
TIO.writeFile String
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
lines
  where
    formatNightlyEntry :: (NightlyVersion, GHCVersion) -> Text
formatNightlyEntry (NightlyVersion
nightly, GHCVersion
ghc) =
      NightlyVersion -> Text
formatNightlyVersion NightlyVersion
nightly Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GHCVersion -> Text
formatGHCVersion GHCVersion
ghc

-- | Generate GHC version map from LTS and nightly maps
generateGHCMap :: [(LTSVersion, GHCVersion)] -> [(NightlyVersion, GHCVersion)] -> Map GHCVersion Snapshot
generateGHCMap :: [(LTSVersion, GHCVersion)]
-> [(NightlyVersion, GHCVersion)] -> Map GHCVersion Snapshot
generateGHCMap [(LTSVersion, GHCVersion)]
ltsEntries [(NightlyVersion, GHCVersion)]
nightlyEntries =
  let ltsMap :: Map GHCVersion Snapshot
ltsMap = ((LTSVersion, GHCVersion)
 -> Map GHCVersion Snapshot -> Map GHCVersion Snapshot)
-> Map GHCVersion Snapshot
-> [(LTSVersion, GHCVersion)]
-> Map GHCVersion Snapshot
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (LTSVersion, GHCVersion)
-> Map GHCVersion Snapshot -> Map GHCVersion Snapshot
forall {k}.
Ord k =>
(LTSVersion, k) -> Map k Snapshot -> Map k Snapshot
insertLTS Map GHCVersion Snapshot
forall k a. Map k a
Map.empty [(LTSVersion, GHCVersion)]
ltsEntries
      nightlyMap :: Map GHCVersion Snapshot
nightlyMap = ((NightlyVersion, GHCVersion)
 -> Map GHCVersion Snapshot -> Map GHCVersion Snapshot)
-> Map GHCVersion Snapshot
-> [(NightlyVersion, GHCVersion)]
-> Map GHCVersion Snapshot
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (NightlyVersion, GHCVersion)
-> Map GHCVersion Snapshot -> Map GHCVersion Snapshot
forall {k}.
Ord k =>
(NightlyVersion, k) -> Map k Snapshot -> Map k Snapshot
insertNightly Map GHCVersion Snapshot
forall k a. Map k a
Map.empty [(NightlyVersion, GHCVersion)]
nightlyEntries
  in Map GHCVersion Snapshot
-> Map GHCVersion Snapshot -> Map GHCVersion Snapshot
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map GHCVersion Snapshot
ltsMap Map GHCVersion Snapshot
nightlyMap
  where
    insertLTS :: (LTSVersion, k) -> Map k Snapshot -> Map k Snapshot
insertLTS (LTSVersion
lts, k
ghc) Map k Snapshot
m =
      (Snapshot -> Snapshot -> Snapshot)
-> k -> Snapshot -> Map k Snapshot -> Map k Snapshot
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\Snapshot
_ Snapshot
old -> Snapshot
old) k
ghc (LTSVersion -> Snapshot
LTS LTSVersion
lts) Map k Snapshot
m
    insertNightly :: (NightlyVersion, k) -> Map k Snapshot -> Map k Snapshot
insertNightly (NightlyVersion
nightly, k
ghc) Map k Snapshot
m =
      (Snapshot -> Snapshot -> Snapshot)
-> k -> Snapshot -> Map k Snapshot -> Map k Snapshot
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\Snapshot
_ Snapshot
old -> Snapshot
old) k
ghc (NightlyVersion -> Snapshot
Nightly NightlyVersion
nightly) Map k Snapshot
m

-- | Write GHC CSV file
writeGHCCSV :: FilePath -> Map GHCVersion Snapshot -> IO ()
writeGHCCSV :: String -> Map GHCVersion Snapshot -> IO ()
writeGHCCSV String
path Map GHCVersion Snapshot
ghcMap = do
  let sorted :: [(GHCVersion, Snapshot)]
sorted = ((GHCVersion, Snapshot) -> (GHCVersion, Snapshot) -> Ordering)
-> [(GHCVersion, Snapshot)] -> [(GHCVersion, Snapshot)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((GHCVersion, Snapshot) -> GHCVersion)
-> (GHCVersion, Snapshot) -> (GHCVersion, Snapshot) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (GHCVersion, Snapshot) -> GHCVersion
forall a b. (a, b) -> a
fst) ([(GHCVersion, Snapshot)] -> [(GHCVersion, Snapshot)])
-> [(GHCVersion, Snapshot)] -> [(GHCVersion, Snapshot)]
forall a b. (a -> b) -> a -> b
$ Map GHCVersion Snapshot -> [(GHCVersion, Snapshot)]
forall k a. Map k a -> [(k, a)]
Map.toList Map GHCVersion Snapshot
ghcMap
  let lines :: [Text]
lines = ((GHCVersion, Snapshot) -> Text)
-> [(GHCVersion, Snapshot)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (GHCVersion, Snapshot) -> Text
formatGHCEntry [(GHCVersion, Snapshot)]
sorted
  String -> Text -> IO ()
TIO.writeFile String
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
lines
  where
    formatGHCEntry :: (GHCVersion, Snapshot) -> Text
formatGHCEntry (GHCVersion
ghc, LTS (LTSVersion Int
maj Int
min)) =
      GHCVersion -> Text
formatGHCVersion GHCVersion
ghc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
",lts-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
maj) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
min)
    formatGHCEntry (GHCVersion
ghc, Nightly NightlyVersion
nightly) =
      GHCVersion -> Text
formatGHCVersion GHCVersion
ghc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
",nightly-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NightlyVersion -> Text
formatNightlyVersion NightlyVersion
nightly

-- | Load snapshot database from CSV files
loadSnapshotDB :: IO SnapshotDB
loadSnapshotDB :: IO SnapshotDB
loadSnapshotDB = do
  stateDir <- IO String
getStateDir

  ltsMap <- readLTSCSV (stateDir </> "lts.csv")
  nightlyMap <- readNightlyCSV (stateDir </> "nightly.csv")
  ghcMap <- readGHCCSV (stateDir </> "ghc.csv")

  return $ SnapshotDB ltsMap nightlyMap ghcMap

-- | Read LTS CSV file
readLTSCSV :: FilePath -> IO (Map LTSVersion GHCVersion)
readLTSCSV :: String -> IO (Map LTSVersion GHCVersion)
readLTSCSV String
path = do
  exists <- String -> IO Bool
doesFileExist String
path
  if not exists
    then return Map.empty
    else do
      content <- TIO.readFile path
      let entries = (Text -> [(LTSVersion, GHCVersion)])
-> [Text] -> [[(LTSVersion, GHCVersion)]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [(LTSVersion, GHCVersion)]
parseLTSLine ([Text] -> [[(LTSVersion, GHCVersion)]])
-> [Text] -> [[(LTSVersion, GHCVersion)]]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
content
      return $ Map.fromList $ concat entries
  where
    parseLTSLine :: Text -> [(LTSVersion, GHCVersion)]
parseLTSLine Text
line =
      case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
line of
        [Text
ver, Text
ghcText] ->
          case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
ver of
            [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 -> String
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 -> String
T.unpack Text
minStr, Text -> Maybe GHCVersion
parseGHCVersionText Text
ghcText) of
                ([(Int
maj, String
"")], [(Int
min, String
"")], Just GHCVersion
ghc) ->
                  [(Int -> Int -> LTSVersion
LTSVersion Int
maj Int
min, GHCVersion
ghc)]
                ([(Int, String)], [(Int, String)], Maybe GHCVersion)
_ -> []
            [Text]
_ -> []
        [Text]
_ -> []

-- | Read nightly CSV file
readNightlyCSV :: FilePath -> IO (Map NightlyVersion GHCVersion)
readNightlyCSV :: String -> IO (Map NightlyVersion GHCVersion)
readNightlyCSV String
path = do
  exists <- String -> IO Bool
doesFileExist String
path
  if not exists
    then return Map.empty
    else do
      content <- TIO.readFile path
      let entries = (Text -> [(NightlyVersion, GHCVersion)])
-> [Text] -> [[(NightlyVersion, GHCVersion)]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [(NightlyVersion, GHCVersion)]
parseNightlyLine ([Text] -> [[(NightlyVersion, GHCVersion)]])
-> [Text] -> [[(NightlyVersion, GHCVersion)]]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
content
      return $ Map.fromList $ concat entries
  where
    parseNightlyLine :: Text -> [(NightlyVersion, GHCVersion)]
parseNightlyLine Text
line =
      case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
line of
        [Text
dateText, Text
ghcText] ->
          case (Text -> Maybe NightlyVersion
parseNightlyVersionText Text
dateText, Text -> Maybe GHCVersion
parseGHCVersionText Text
ghcText) of
            (Just NightlyVersion
nightly, Just GHCVersion
ghc) -> [(NightlyVersion
nightly, GHCVersion
ghc)]
            (Maybe NightlyVersion, Maybe GHCVersion)
_ -> []
        [Text]
_ -> []

-- | Read GHC CSV file
readGHCCSV :: FilePath -> IO (Map GHCVersion Snapshot)
readGHCCSV :: String -> IO (Map GHCVersion Snapshot)
readGHCCSV String
path = do
  exists <- String -> IO Bool
doesFileExist String
path
  if not exists
    then return Map.empty
    else do
      content <- TIO.readFile path
      let entries = (Text -> [(GHCVersion, Snapshot)])
-> [Text] -> [[(GHCVersion, Snapshot)]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [(GHCVersion, Snapshot)]
parseGHCLine ([Text] -> [[(GHCVersion, Snapshot)]])
-> [Text] -> [[(GHCVersion, Snapshot)]]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
content
      return $ Map.fromList $ concat entries
  where
    parseGHCLine :: Text -> [(GHCVersion, Snapshot)]
parseGHCLine Text
line =
      case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
line of
        [Text
ghcText, Text
snap] ->
          case (Text -> Maybe GHCVersion
parseGHCVersionText Text
ghcText, Text -> Maybe Snapshot
parseSnapshot Text
snap) of
            (Just GHCVersion
ghc, Just Snapshot
s) -> [(GHCVersion
ghc, Snapshot
s)]
            (Maybe GHCVersion, Maybe Snapshot)
_ -> []
        [Text]
_ -> []
    parseSnapshot :: Text -> Maybe Snapshot
parseSnapshot Text
snap
      | Text -> Text -> Bool
T.isPrefixOf Text
"lts-" Text
snap =
          case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." (Int -> Text -> Text
T.drop Int
4 Text
snap) of
            [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 -> String
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 -> String
T.unpack Text
minStr) of
                ([(Int
maj, String
"")], [(Int
min, String
"")]) -> Snapshot -> Maybe Snapshot
forall a. a -> Maybe a
Just (Snapshot -> Maybe Snapshot) -> Snapshot -> Maybe Snapshot
forall a b. (a -> b) -> a -> b
$ LTSVersion -> Snapshot
LTS (LTSVersion -> Snapshot) -> LTSVersion -> Snapshot
forall a b. (a -> b) -> a -> b
$ Int -> Int -> LTSVersion
LTSVersion Int
maj Int
min
                ([(Int, String)], [(Int, String)])
_ -> Maybe Snapshot
forall a. Maybe a
Nothing
            [Text]
_ -> Maybe Snapshot
forall a. Maybe a
Nothing
      | Text -> Text -> Bool
T.isPrefixOf Text
"nightly-" Text
snap =
          case Text -> Maybe NightlyVersion
parseNightlyVersionText (Int -> Text -> Text
T.drop Int
8 Text
snap) of
            Just NightlyVersion
nightly -> Snapshot -> Maybe Snapshot
forall a. a -> Maybe a
Just (Snapshot -> Maybe Snapshot) -> Snapshot -> Maybe Snapshot
forall a b. (a -> b) -> a -> b
$ NightlyVersion -> Snapshot
Nightly NightlyVersion
nightly
            Maybe NightlyVersion
Nothing -> Maybe Snapshot
forall a. Maybe a
Nothing
      | Bool
otherwise = Maybe Snapshot
forall a. Maybe a
Nothing