{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module Axel.Haskell.Project where import qualified Axel.Eff.Console as Effs (Console) import Axel.Eff.FileSystem ( copyFile , getCurrentDirectory , getDirectoryContentsRec , removeFile ) import qualified Axel.Eff.FileSystem as Effs (FileSystem) import qualified Axel.Eff.Ghci as Effs (Ghci) import qualified Axel.Eff.Process as Effs (Process) import Axel.Eff.Resource (getResourcePath, newProjectTemplate) import qualified Axel.Eff.Resource as Effs (Resource) import Axel.Error (Error) import Axel.Haskell.File (readModuleInfo, transpileFile') import Axel.Haskell.Stack ( addStackDependency , axelStackageId , buildStackProject , createStackProject , runStackProject ) import Control.Monad (void) import Control.Monad.Freer (Eff, Members) import qualified Control.Monad.Freer.Error as Effs (Error) import Control.Monad.Freer.State (evalState) import Data.Semigroup ((<>)) import qualified Data.Text as T (isSuffixOf, pack) import System.FilePath (()) type ProjectPath = FilePath newProject :: Members '[ Effs.FileSystem, Effs.Process, Effs.Resource] effs => String -> Eff effs () newProject projectName = do createStackProject projectName addStackDependency axelStackageId projectName templatePath <- getResourcePath newProjectTemplate 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 :: (Members '[ Effs.Console, Effs.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Process, Effs.Resource] effs) => Eff effs [FilePath] transpileProject = do files <- concat <$> mapM getDirectoryContentsRec ["app", "src", "test"] let axelFiles = filter (\filePath -> ".axel" `T.isSuffixOf` T.pack filePath) files moduleInfo <- readModuleInfo axelFiles evalState moduleInfo $ mapM transpileFile' axelFiles buildProject :: (Members '[ Effs.Console, Effs.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Process, Effs.Resource] effs) => Eff effs () buildProject = do projectPath <- getCurrentDirectory void transpileProject buildStackProject projectPath runProject :: (Members '[ Effs.Console, Effs.Error Error, Effs.FileSystem, Effs.Process] effs) => Eff effs () runProject = getCurrentDirectory >>= runStackProject