module Development.Duplo.Component where
import Control.Exception (throw)
import Control.Lens.Operators
import Control.Monad (liftM)
import Data.Aeson (decode, encode)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BS (pack, unpack)
import Data.HashMap.Lazy (lookup)
import Data.List (isPrefixOf)
import Data.Map (fromList)
import Data.Maybe (fromMaybe)
import Data.Text (breakOn)
import qualified Data.Text as T (pack, unpack)
import Development.Duplo.Types.AppInfo (AppInfo (..))
import qualified Development.Duplo.Types.AppInfo as AI
import qualified Development.Duplo.Types.Builder as BD
import qualified Development.Duplo.Types.Config as TC
import Development.Shake hiding (doesDirectoryExist,
doesFileExist,
getDirectoryContents)
import Development.Shake.FilePath ((</>))
import Prelude hiding (lookup)
import System.Directory (doesDirectoryExist,
doesFileExist,
getCurrentDirectory,
getDirectoryContents)
import System.FilePath.Posix (splitDirectories)
type Version = (String, String)
manifestName :: FilePath
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
appId :: AppInfo -> String
appId appInfo = parseRepoInfo $ splitDirectories $ AI.repo appInfo
parseRepoInfo :: [String] -> String
parseRepoInfo (owner : appRepo : _) = owner ++ "-" ++ appRepo
parseRepoInfo _ = ""
parseComponentId :: String -> Either String (String, String)
parseComponentId cId
| repoL > 0 = Right (T.unpack user, T.unpack userRepo)
| otherwise = Left $ "No component ID found with " ++ cId
where
(user, userRepo) = breakOn (T.pack "-") (T.pack cId)
repoL = length $ T.unpack userRepo
extractCompVersions :: TC.BuildConfig -> Action String
extractCompVersions config = do
let path = config ^. TC.cwd
let utilPath = config ^. TC.utilPath
paths <- getAllManifestPaths utilPath path
let toVersion path' = appInfoToVersion . decodeManifest path' . BS.pack
let takeVersion path' = liftM (toVersion path') (readFile path')
manifests <- mapM (liftIO . takeVersion) paths
return $ BS.unpack $ encode $ fromList manifests
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)
getAllManifestPaths :: FilePath -> FilePath -> Action [FilePath]
getAllManifestPaths utilPath root = do
Stdout out <- command [] (utilPath </> "find.sh") [root, manifestName]
return $ lines out
getDependencies :: Maybe String -> IO [FilePath]
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 []
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
getDependencies' :: AI.Dependencies -> Maybe [String] -> IO [FilePath]
getDependencies' _ Nothing = getDependencies Nothing
getDependencies' _ (Just modeDeps) = return modeDeps
isRegularFile :: FilePath -> Bool
isRegularFile = not . isPrefixOf "."