{-# LANGUAGE DeriveGeneric #-}
module Data.Project
( Project(..)
, readProject
)
where
import Control.Exception (IOException, try)
import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict')
import qualified Data.ByteString as BS
import Data.List (stripPrefix)
import GHC.Generics (Generic)
import System.Directory (makeAbsolute)
import System.FilePath (isAbsolute, takeDirectory, (</>))
import Data.Either.Extra (mapLeft)
data Project = Project
{ Project -> Maybe String
projectName :: Maybe String
, Project -> [(String, String, String)]
projectInputFiles :: [(FilePath, String, String)]
, Project -> Maybe String
projectVariableFiles :: Maybe FilePath
, Project -> Maybe String
projectVariableDBFile :: Maybe FilePath
, Project -> Maybe String
projectHandlerFile :: Maybe FilePath
, Project -> Maybe String
projectCommandPropVia :: Maybe FilePath
, Project -> Maybe String
projectTemplateDir :: Maybe FilePath
, Project -> Maybe String
projectTargetDir :: Maybe FilePath
, :: Maybe FilePath
}
deriving ((forall x. Project -> Rep Project x)
-> (forall x. Rep Project x -> Project) -> Generic Project
forall x. Rep Project x -> Project
forall x. Project -> Rep Project x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Project -> Rep Project x
from :: forall x. Project -> Rep Project x
$cto :: forall x. Rep Project x -> Project
to :: forall x. Rep Project x -> Project
Generic, Int -> Project -> ShowS
[Project] -> ShowS
Project -> String
(Int -> Project -> ShowS)
-> (Project -> String) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Project -> ShowS
showsPrec :: Int -> Project -> ShowS
$cshow :: Project -> String
show :: Project -> String
$cshowList :: [Project] -> ShowS
showList :: [Project] -> ShowS
Show)
instance FromJSON Project
instance ToJSON Project
readProject :: FilePath -> IO (Either String Project)
readProject :: String -> IO (Either String Project)
readProject String
path = do
bytesResult <- IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO ByteString
BS.readFile String
path)
let project = case Either IOException ByteString
bytesResult of
Left IOException
e -> String -> Either String Project
forall a b. a -> Either a b
Left (IOException -> String
forall a. Show a => a -> String
show (IOException
e :: IOException))
Right ByteString
bytes -> ShowS -> Either String Project -> Either String Project
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (String
"Failed to read project: " String -> ShowS
forall a. [a] -> [a] -> [a]
++)
(Either String Project -> Either String Project)
-> Either String Project -> Either String Project
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Project
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
bytes
projectDir <- takeDirectory <$> makeAbsolute path
pure $ resolveProjectPaths projectDir <$> project
resolveProjectPaths :: FilePath -> Project -> Project
resolveProjectPaths :: String -> Project -> Project
resolveProjectPaths String
projectDir Project
p = Project
p
{ projectInputFiles = resolveInputFile projectDir <$> projectInputFiles p
, projectVariableFiles = resolvePath projectDir <$> projectVariableFiles p
, projectVariableDBFile = resolvePath projectDir <$> projectVariableDBFile p
, projectHandlerFile = resolvePath projectDir <$> projectHandlerFile p
, projectCommandPropVia = resolvePath projectDir <$> projectCommandPropVia p
, projectTemplateDir = resolvePath projectDir <$> projectTemplateDir p
, projectTargetDir = resolvePath projectDir <$> projectTargetDir p
, projectExtraJSONFile = resolvePath projectDir <$> projectExtraJSONFile p
}
resolveInputFile :: FilePath
-> (FilePath, String, String)
-> (FilePath, String, String)
resolveInputFile :: String -> (String, String, String) -> (String, String, String)
resolveInputFile String
projectDir (String
filePath, String
fileFormat, String
propName) =
(String
filePath', String
fileFormat', String
propName)
where
filePath' :: String
filePath' = String -> ShowS
resolvePath String
projectDir String
filePath
fileFormat' :: String
fileFormat' = String -> ShowS
resolvePath String
projectDir String
fileFormat
resolvePath :: FilePath -> FilePath -> FilePath
resolvePath :: String -> ShowS
resolvePath String
projectDir String
path
| String -> Bool
isAbsolute String
path
= String
path
| Just String
path' <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"cwd:" String
path
= String
path'
| Just String
path' <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"cmd:" String
path
= String
path'
| Just String
path' <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"project:" String
path
= String
projectDir String -> ShowS
</> String
path'
| Bool
otherwise
= String
projectDir String -> ShowS
</> String
path