Project.hs

{-# LANGUAGE OverloadedStrings #-}

module Axel.Project where

import Axel.Entry (transpileFile')
import Axel.Utils.Directory (getRecursiveContents)

import Control.Lens ((%~))
import Control.Monad (void)
import Control.Monad.Except (throwError)
import Control.Monad.IO.Class (liftIO)

import Data.Aeson.Lens (_Array, key)
import Data.Function ((&))
import Data.List (foldl')
import Data.Semigroup ((<>))
import qualified Data.Text as T (append, isSuffixOf, pack)
import Data.Vector (cons)
import Data.Version (showVersion)
import Data.Yaml (Value(String), decodeFileEither, encodeFile)

import Paths_axel (getDataFileName, version)

import System.Directory (copyFile, removeFile, setCurrentDirectory)
import System.FilePath ((</>))
import System.Process (readProcess, readProcessWithExitCode)
import System.Process.Typed (proc, runProcess)

import Text.Regex.PCRE ((=~), getAllTextSubmatches)

newProject :: String -> IO ()
newProject projectName = do
  void $ readProcess "stack" ["new", projectName, "new-template"] ""
  setCurrentDirectory projectName
  void $
    readProcess "stack" ["config", "set", "resolver", "nightly-2018-08-17"] ""
  templatePath <- getDataFileName ("resources" </> "new-project-template")
  let copyAxel filePath = do
        copyFile
          (templatePath </> filePath <> ".axel")
          (projectName </> filePath <> ".axel")
        removeFile (projectName </> filePath <> ".hs")
  mapM_ copyAxel ["Setup", "app" </> "Main", "src" </> "Lib", "test" </> "Spec"]

transpileProject :: IO [FilePath]
transpileProject = do
  files <- getRecursiveContents "."
  let axelFiles =
        filter (\filePath -> ".axel" `T.isSuffixOf` T.pack filePath) files
  mapM transpileFile' axelFiles

addAxelDependency :: IO ()
addAxelDependency = do
  let packageConfigPath = "package.yaml"
  let axelHackageVersion = T.pack $ showVersion version
  decodeResult <- decodeFileEither packageConfigPath
  case decodeResult of
    Right contents ->
      let newContents :: Value
          newContents =
            contents & key "dependencies" . _Array %~
            cons (String $ T.append "axel ==" axelHackageVersion)
      in encodeFile packageConfigPath newContents
    Left err ->
      throwError
        (userError $ "`package.yaml` could not be parsed: " <> show err)

buildProject :: IO ()
buildProject = do
  hsPaths <- transpileProject
  addAxelDependency
  void $ readProcess "stack" ["build"] ""
  mapM_ removeFile hsPaths

runProject :: IO ()
runProject = do
  (_, _, stderr) <- readProcessWithExitCode "stack" ["ide", "targets"] ""
  let targets = lines stderr
  case findExeTargets targets of
    [target] -> do
      liftIO $ putStrLn ("Running " <> target <> "...")
      void $ runProcess $ proc "stack" ["exec", target]
    _ -> throwError (userError "No executable target was unambiguously found!")
  where
    findExeTargets =
      foldl'
        (\acc target ->
           case getAllTextSubmatches $ target =~
                ("([^:]*):exe:([^:]*)" :: String) of
             [_fullMatch, _projectName, targetName] -> targetName : acc
             _ -> acc)
        []