{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}
module Coolbal.CabalPlan (
    CabalPlan(..),
    PlanPackage(..),
    parseCabalPlan,
) where

import qualified Data.Bytes as Bytes
import Data.Foldable (toList)
import Data.List (find)
import qualified GHC.Exts as IsList (IsList(..))
import qualified Json


data CabalPlan = CabalPlan
    { planCompiler :: String
    , planPackages :: [PlanPackage] }
  deriving (Show)

data PlanPackage
    = PreExisting 
        { ppName :: String
        , ppVersion :: String
        , ppDepends :: [String] }
    | Configured
        { ppName :: String
        , ppVersion :: String
        , ppLocal :: Bool
        , ppComponent :: String
        , ppDepends :: [String] }
  deriving (Show)


parseCabalPlan :: FilePath -> IO (Maybe CabalPlan)
parseCabalPlan fpath = parseFromValue <$> Bytes.readFile fpath
  where
    parseFromValue (Json.decode -> Right toplevel) = do
        Json.Object obj <- return toplevel
        Json.String compiler <- locate "compiler-id" obj
        Json.Array pkgs <- locate "install-plan" obj
        CabalPlan (IsList.toList compiler) <$> mapM parsePackage (toList pkgs)
    parseFromValue _ = Nothing

    parsePackage value = do
        Json.Object obj <- return value
        Json.String typ <- locate "type" obj
        Json.String name <- locate "pkg-name" obj
        Json.String version <- locate "pkg-version" obj
        Json.Array dependsArr <- locate "depends" obj
        depends <- mapM (\case Json.String s -> Just s ; _ -> Nothing) (toList dependsArr)
        if | typ == IsList.fromList "pre-existing" ->
               return (PreExisting (IsList.toList name) (IsList.toList version) (map IsList.toList depends))
           | typ == IsList.fromList "configured" -> do
               Json.String style <- locate "style" obj
               Json.String component <- locate "component-name" obj
               return (Configured (IsList.toList name) (IsList.toList version)
                                  (style == IsList.fromList "local")
                                  (IsList.toList component)
                                  (map IsList.toList depends))
           | otherwise ->
               Nothing

locate :: Foldable f => String -> f Json.Member -> Maybe Json.Value
locate key = fmap (\(Json.Member _ v) -> v) . find (\(Json.Member k _) -> k == IsList.fromList key)