descript-lang-0.2.0.0: app/Action.hs

{-# LANGUAGE DeriveFunctor #-}

-- | Defines different actions and their arguments.
module Action
  ( Action (..)
  , IndivAction (..)
  , Compile (..)
  , Eval (..)
  , Refactor (..)
  , Watcher (..)
  , PathAction (..)
  , mkCompile
  , mkRefactor
  ) where

import Data.Maybe
import System.FilePath

data Action
  = ActionServe
  | ActionIndiv (Watcher IndivAction)

data IndivAction
  = ActionCompile Compile
  | ActionEval Eval
  | ActionRefactor Refactor

data Compile
  = Compile
  { compilePath :: FilePath
  , compileOutDir :: FilePath
  }

newtype Eval = Eval{ evalPath :: FilePath }

data Refactor
  = Refactor
  { refactorAction :: String
  , refactorArgs :: [String]
  , refactorPath :: FilePath
  , refactorOutPath :: FilePath
  }

data Watcher a = Watcher Bool a deriving (Functor)

class PathAction a where
  getSrcPath :: a -> FilePath
  setSrcPath :: FilePath -> a -> a

instance PathAction IndivAction where
  getSrcPath (ActionCompile x) = getSrcPath x
  getSrcPath (ActionEval x) = getSrcPath x
  getSrcPath (ActionRefactor x) = getSrcPath x
  setSrcPath new (ActionCompile x) = ActionCompile $ setSrcPath new x
  setSrcPath new (ActionEval x) = ActionEval $ setSrcPath new x
  setSrcPath new (ActionRefactor x) = ActionRefactor $ setSrcPath new x

instance PathAction Compile where
  getSrcPath = compilePath
  setSrcPath new x = x{ compilePath = new }

instance PathAction Eval where
  getSrcPath = evalPath
  setSrcPath new x = x{ evalPath = new }

instance PathAction Refactor where
  getSrcPath = refactorPath
  setSrcPath new x = x{ refactorPath = new }

mkCompile :: FilePath -> Maybe FilePath -> Compile
mkCompile path optOutDir
  = Compile
  { compilePath = path
  , compileOutDir = takeDirectory path `fromMaybe` optOutDir
  }

mkRefactor :: String -> [String] -> FilePath -> Maybe FilePath -> Refactor
mkRefactor action args path optOutPath
  = Refactor
  { refactorAction = action
  , refactorArgs = args
  , refactorPath = path
  , refactorOutPath = path `fromMaybe` optOutPath
  }