Plan.hs

{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module App.Commands.Plan
  ( cmdPlan
  ) where

import Antiope.Core                     (toText)
import App.Commands.Options.Types       (PlanOptions (PlanOptions))
import Control.Applicative
import Control.Lens                     hiding ((<.>))
import Control.Monad.Except
import Data.Generics.Product.Any        (the)
import Data.Maybe
import HaskellWorks.CabalCache.AppError
import HaskellWorks.CabalCache.Location (Location (..), (<.>), (</>))
import HaskellWorks.CabalCache.Show
import HaskellWorks.CabalCache.Version  (archiveVersion)
import Options.Applicative              hiding (columns)

import qualified App.Commands.Options.Types         as Z
import qualified App.Static                         as AS
import qualified Control.Concurrent.STM             as STM
import qualified Data.ByteString.Lazy               as LBS
import qualified Data.Text                          as T
import qualified HaskellWorks.CabalCache.Core       as Z
import qualified HaskellWorks.CabalCache.Hash       as H
import qualified HaskellWorks.CabalCache.IO.Console as CIO
import qualified System.IO                          as IO
import qualified Data.Aeson as J

{- HLINT ignore "Monoid law, left identity" -}
{- HLINT ignore "Redundant do"              -}
{- HLINT ignore "Reduce duplication"        -}

runPlan :: Z.PlanOptions -> IO ()
runPlan opts = do
  let storePath             = opts ^. the @"storePath"
  let archiveUris           = [Local ""]
  let storePathHash         = opts ^. the @"storePathHash" & fromMaybe (H.hashStorePath storePath)
  let versionedArchiveUris  = archiveUris & each %~ (</> archiveVersion)
  let outputFile            = opts ^. the @"outputFile"

  CIO.putStrLn $ "Store path: "       <> toText storePath
  CIO.putStrLn $ "Store path hash: "  <> T.pack storePathHash
  CIO.putStrLn $ "Archive URIs: "     <> tshow archiveUris
  CIO.putStrLn $ "Archive version: "  <> archiveVersion

  tEarlyExit <- STM.newTVarIO False

  mbPlan <- Z.loadPlan $ opts ^. the @"buildPath"

  case mbPlan of
    Right planJson -> do
      packages <- Z.getPackages storePath planJson

      plan <- forM packages $ \pInfo -> do
        let archiveFileBasename = Z.packageDir pInfo <.> ".tar.gz"
        let archiveFiles         = versionedArchiveUris <&> (</> T.pack archiveFileBasename)
        let scopedArchiveFiles   = versionedArchiveUris <&> (</> T.pack storePathHash </> T.pack archiveFileBasename)

        return $ archiveFiles <> scopedArchiveFiles

      if outputFile == "-"
        then LBS.putStr $ J.encode (fmap (fmap toText) plan)
        else LBS.writeFile outputFile $ J.encode (fmap (fmap toText) plan)

    Left (appError :: AppError) -> do
      CIO.hPutStrLn IO.stderr $ "ERROR: Unable to parse plan.json file: " <> displayAppError appError

  earlyExit <- STM.readTVarIO tEarlyExit

  when earlyExit $ CIO.hPutStrLn IO.stderr "Early exit due to error"

optsPlan :: Parser PlanOptions
optsPlan = PlanOptions
  <$> strOption
      (   long "build-path"
      <>  help ("Path to cabal build directory.  Defaults to " <> show AS.buildPath)
      <>  metavar "DIRECTORY"
      <>  value AS.buildPath
      )
  <*> strOption
      (   long "store-path"
      <>  help "Path to cabal store"
      <>  metavar "DIRECTORY"
      <>  value (AS.cabalDirectory </> "store")
      )
  <*> optional
      ( strOption
        (   long "store-path-hash"
        <>  help "Store path hash (do not use)"
        <>  metavar "HASH"
        )
      )
  <*> strOption
      (   long "output-file"
      <>  help "Output file"
      <>  metavar "FILE"
      <>  value "-"
      )

cmdPlan :: Mod CommandFields (IO ())
cmdPlan = command "plan"  $ flip info idm $ runPlan <$> optsPlan