Files.hs

{-# LANGUAGE TemplateHaskell #-}

module Development.Duplo.Files where

import Control.Exception (throw)
import Control.Lens hiding (Action)
import Control.Lens.TH (makeLenses)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.Trans.Class (lift)
import Data.List (intercalate)
import Data.Text (split, pack, unpack)
import Development.Duplo.Component (appId)
import Development.Shake hiding (readFile)
import Prelude hiding (readFile)
import System.FilePath.Posix (makeRelative, splitDirectories, joinPath)
import qualified Development.Duplo.Component as CM
import qualified Development.Duplo.Types.Builder as BD

type FileName    = String
type FileContent = String
type ComponentId = String
data File        = File { _filePath    :: FilePath
                        , _fileDir     :: FilePath
                        , _fileName    :: FileName
                        , _componentId :: ComponentId
                        , _fileContent :: String
                        -- Is this part of the root project?
                        , _isRoot      :: Bool
                        } deriving (Show)

pseudoFile = File { _filePath    = ""
                  , _fileDir     = ""
                  , _fileName    = ""
                  , _componentId = ""
                  , _fileContent = ""
                  , _isRoot      = False
                  }

makeLenses ''File

readFile :: FilePath -> FilePath -> ExceptT String Action File
readFile cwd path = do
  let (fileDir, fileName) = parseFilePath path
  fileContent <- lift $ readFile' path
  appInfo <- liftIO CM.readManifest
  let appId' = appId appInfo
  let componentId = parseComponentId cwd appId' fileDir
  let isRoot = componentId == appId'
  return $ File path fileDir fileName componentId fileContent isRoot

parseFilePath :: FilePath -> (FilePath, FileName)
parseFilePath path = (fileDir, fileName)
  where
    segments  = splitDirectories path
    segLength = length segments
    dirLength = segLength - 1
    fileDir   = joinPath $ take dirLength segments
    fileName  = segments !! dirLength

-- | Given a default component ID (usually the ID of the project on which
-- duplo is run) and the file path, deduce the component ID of a particular
-- file
parseComponentId :: FilePath -> ComponentId -> FilePath -> ComponentId
parseComponentId cwd defaultId path =
  let
    relPath  = makeRelative cwd path
    segments = splitDirectories relPath
  in
    case segments of
      ("components" : appId : xs) -> appId
      _                           -> defaultId