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)
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 repo)
| otherwise = Left $ "No component ID found with " ++ cId
where
(user, repo) = breakOn (T.pack "-") (T.pack cId)
repoL = length $ T.unpack repo
extractCompVersions :: FilePath -> IO String
extractCompVersions path = do
paths <- getAllManifestPaths path
let toVersion path = appInfoToVersion . decodeManifest path . BS.pack
let takeVersion path = liftM (toVersion path) (readFile path)
manifests <- mapM 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 -> IO [FilePath]
getAllManifestPaths root = allPaths
where
matchName path t = takeFileName path == takeFileName manifestName
filterP = filterPredicate matchName
componentsPath = dropTrailingPathSeparator $ root </> "components/"
proceed absPath = equalFilePath root absPath
|| componentsPath `isPrefixOf` absPath
recurseP = recursePredicate proceed
allPaths = findp filterP recurseP root
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' deps Nothing = getDependencies Nothing
getDependencies' deps (Just modeDeps) = return modeDeps
isRegularFile :: FilePath -> Bool
isRegularFile = not . isPrefixOf "."