{-# LANGUAGE TupleSections #-} module Development.Duplo.Component where import Control.Applicative ((<$>), (<*>)) import Control.Exception (throw) import Control.Monad (when, liftM) import Control.Monad.Trans.Class (lift) import Data.Aeson (encode, decode) import Data.Aeson.Encode.Pretty (encodePretty) import Data.ByteString.Lazy.Char8 (ByteString) import Data.HashMap.Lazy (empty, keys, lookup) import Data.List (isPrefixOf) import Data.Map (fromList) import Data.Maybe (fromJust, fromMaybe) import Data.Text (breakOn) import Development.Duplo.Types.AppInfo (AppInfo(..)) import Development.Shake hiding (doesFileExist, getDirectoryContents, doesDirectoryExist) import Development.Shake.FilePath (()) import Prelude hiding (lookup) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents, getCurrentDirectory) import System.FilePath.FilePather.FilterPredicate (filterPredicate) import System.FilePath.FilePather.Find (findp) import System.FilePath.FilePather.RecursePredicate (recursePredicate) import System.FilePath.Posix (makeRelative, dropExtension, splitDirectories, equalFilePath, takeFileName, dropTrailingPathSeparator) import qualified Data.ByteString.Lazy.Char8 as BS (unpack, pack) import qualified Data.Text as T (unpack, pack) import qualified Development.Duplo.Types.AppInfo as AI import qualified Development.Duplo.Types.Builder as BD type Version = (String, String) -- | Each application must have a `component.json` manifestName = "component.json" readManifest :: IO AppInfo readManifest = do exists <- doesFileExist manifestName if exists then readManifest' manifestName else throw $ BD.MissingManifestException manifestName readManifest' :: FilePath -> IO AppInfo readManifest' path = do manifest <- readFile path let maybeAppInfo = decode (BS.pack manifest) :: Maybe AppInfo case maybeAppInfo of Nothing -> throw $ BD.MalformedManifestException path Just a -> return a writeManifest :: AppInfo -> IO () writeManifest = writeFile manifestName . BS.unpack . encodePretty -- | Get the app's Component.IO ID appId :: AppInfo -> String appId appInfo = parseRepoInfo $ splitDirectories $ AI.repo appInfo -- | Parse the repo info into an app ID parseRepoInfo :: [String] -> String parseRepoInfo (owner : appRepo : _) = owner ++ "-" ++ appRepo parseRepoInfo _ = "" -- | Given a possible component ID, return the user and the repo -- constituents parseComponentId :: String -> Either String (String, String) parseComponentId cId | repoL > 0 = Right (T.unpack user, T.unpack repo) | otherwise = Left $ "No component ID found with " ++ cId where (user, repo) = breakOn (T.pack "-") (T.pack cId) repoL = length $ T.unpack repo -- | Given a path, find all the `component.json` and return a JSON string extractCompVersions :: FilePath -> IO String extractCompVersions path = do -- Get all the relevant paths paths <- getAllManifestPaths path -- Construct the pipeline let toVersion path = appInfoToVersion . decodeManifest path . BS.pack let takeVersion path = liftM (toVersion path) (readFile path) -- Go through it manifests <- mapM takeVersion paths -- Marshalling return $ BS.unpack $ encode $ fromList manifests -- | Given a path and the file content that the path points to, return the -- manifest in `AppInfo` form. decodeManifest :: FilePath -> ByteString -> AppInfo decodeManifest path content = fromMaybe whenNothing decodedContent where whenNothing = throw $ BD.MalformedManifestException path decodedContent = decode content :: Maybe AppInfo appInfoToVersion :: AppInfo -> Version appInfoToVersion appInfo = (AI.name appInfo, AI.version appInfo) -- | Given a path, find all the `component.json`s getAllManifestPaths :: FilePath -> IO [FilePath] getAllManifestPaths root = allPaths where -- Filter for `component.json`. matchName path t = takeFileName path == takeFileName manifestName filterP = filterPredicate matchName -- We only care about the root directory and the `components/` directory. componentsPath = dropTrailingPathSeparator $ root "components/" proceed absPath = equalFilePath root absPath || componentsPath `isPrefixOf` absPath recurseP = recursePredicate proceed -- Collect the paths here. allPaths = findp filterP recurseP root -- | Get the component dependency list by providing a mode, or not. getDependencies :: Maybe String -> IO [FilePath] -- | Simply get all dependencies if no mode is provided. getDependencies Nothing = do cwd <- getCurrentDirectory let depDir = cwd "components/" depDirExists <- doesDirectoryExist depDir let filterRegular = fmap $ filter isRegularFile filterRegular $ if depDirExists then getDirectoryContents depDir else return [] -- | Only select the named dependencies. getDependencies (Just mode) = do fullDeps <- fmap AI.dependencies readManifest depModes <- fmap AI.modes readManifest getDependencies' fullDeps $ case depModes of Just d -> lookup mode d Nothing -> Nothing -- | Helper function to get the selected dependency list given the full -- dependency list, all modes, and the target mode to select the list by. getDependencies' :: AI.Dependencies -> Maybe [String] -> IO [FilePath] -- If somehow there isn't a mode defined, switch over to `Nothing`. getDependencies' deps Nothing = getDependencies Nothing -- If there is something, fetch only those dependencies. getDependencies' deps (Just modeDeps) = return modeDeps -- | Regular file != *nix-style hidden file isRegularFile :: FilePath -> Bool isRegularFile = not . isPrefixOf "."