diff --git a/Kit/CmdArgs.hs b/Kit/CmdArgs.hs --- a/Kit/CmdArgs.hs +++ b/Kit/CmdArgs.hs @@ -4,7 +4,7 @@ import System.Console.CmdArgs as CA appVersion :: String - appVersion = "0.6.7" -- TODO how to keep this up to date with kit.cabal? + appVersion = "0.7.0" -- TODO how to keep this up to date with kit.cabal? data KitCmdArgs = Update | Package diff --git a/Kit/Commands.hs b/Kit/Commands.hs --- a/Kit/Commands.hs +++ b/Kit/Commands.hs @@ -3,24 +3,23 @@ Command, liftKit, mySpec, - mySpecFile, + myWorkingCopy, myRepository, runCommand, - defaultLocalRepoPath, defaultLocalRepository ) where import Kit.Util import Kit.Spec import Kit.Repository +import Kit.WorkingCopy -import qualified Data.ByteString as BS import System.Exit (exitFailure) import Control.Monad.Error import Control.Monad.Reader -newtype Command a = Command (ReaderT (KitSpec, KitRepository) (ErrorT String IO) a) deriving Monad +newtype Command a = Command (ReaderT (WorkingCopy, KitRepository) (ErrorT String IO) a) deriving (Monad, Functor, Applicative) instance MonadIO Command where liftIO a = Command $ liftIO a @@ -29,32 +28,22 @@ liftKit = Command . ReaderT . const mySpec :: Command KitSpec -mySpec = Command $ fmap fst ask +mySpec = fmap workingKitSpec myWorkingCopy +myWorkingCopy :: Command WorkingCopy +myWorkingCopy = Command $ fmap fst ask + myRepository :: Command KitRepository myRepository = Command $ fmap snd ask -mySpecFile :: Command FilePath -mySpecFile = return "KitSpec" - runCommand :: Command a -> IO () runCommand (Command cmd) = run $ do - spec <- readSpec "KitSpec" + spec <- currentWorkingCopy repository <- liftIO defaultLocalRepository runReaderT cmd (spec, repository) where run = (handleFails =<<) . runErrorT handleFails = either (\msg -> putStrLn ("kit error: " ++ msg) >> exitFailure) (const $ return ()) -defaultLocalRepoPath :: IO FilePath -defaultLocalRepoPath = ( ".kit" "repository") <$> getHomeDirectory - defaultLocalRepository :: IO KitRepository -defaultLocalRepository = KitRepository <$> defaultLocalRepoPath - -readSpec :: FilePath -> KitIO KitSpec -readSpec path = checkExists path >>= liftIO . BS.readFile >>= ErrorT . return . parses - where checkExists pathToSpec = do - doesExist <- liftIO $ doesFileExist pathToSpec - if doesExist then return pathToSpec else throwError $ "Couldn't find the spec at " ++ pathToSpec - parses = maybeToRight "Parse error in KitSpec file" . decodeSpec +defaultLocalRepository = makeRepository =<< ( ".kit" ) <$> getHomeDirectory diff --git a/Kit/Contents.hs b/Kit/Contents.hs --- a/Kit/Contents.hs +++ b/Kit/Contents.hs @@ -1,63 +1,63 @@ +{-# LANGUAGE PackageImports #-} module Kit.Contents ( KitContents(..), - readKitContents, - namedPrefix, - makeContentsRelative + readKitContents', + namedPrefix ) where import Kit.Spec import Kit.Util import Kit.Xcode.XCConfig +import "mtl" Control.Monad.Trans import qualified Data.Traversable as T -- | The determined contents of a particular Kit data KitContents = KitContents { - contentKit :: Kit, + contentSpec :: KitSpec, contentHeaders :: [FilePath], -- ^ Paths to headers contentSources :: [FilePath], -- ^ Paths to source files contentLibs :: [FilePath], -- ^ Paths to static libs contentConfig :: Maybe XCConfig, -- ^ Contents of the xcconfig base file - contentPrefix :: Maybe String -- ^ Contents of the prefix header + contentPrefix :: Maybe String, -- ^ Contents of the prefix header + contentResourceDir :: Maybe FilePath } -makeContentsRelative :: FilePath -> KitContents -> KitContents -makeContentsRelative base kc = let f p = map (makeRelative base) (p kc) - in kc { contentHeaders = f contentHeaders, - contentSources = f contentSources, - contentLibs = f contentLibs - } - namedPrefix :: KitContents -> Maybe String -namedPrefix kc = fmap (\s -> "//" ++ (packageFileName . contentKit $ kc) ++ "\n" ++ s) $ contentPrefix kc +namedPrefix kc = fmap (\s -> "//" ++ (packageFileName . contentSpec $ kc) ++ "\n" ++ s) $ contentPrefix kc --- | Determine the contents for a Kit, assumes that we're in a --- folder containing exploded kits -readKitContents :: KitSpec -> IO KitContents -readKitContents spec = - let kitDir = packageFileName spec - find dir tpe = do +readKitContents' :: (Applicative m, MonadIO m) => FilePath -> (KitSpec -> FilePath) -> KitSpec -> m KitContents +readKitContents' base f spec = + let kitDir = f spec + find dir tpe = liftIO $ inDirectory base $ do files <- glob ((kitDir dir "**/*") ++ tpe) mapM canonicalizePath files findSrc = find $ specSourceDirectory spec headers = findSrc ".h" - sources = join <$> mapM findSrc [".m", ".mm", ".c"] + sources = findSrc .=<<. [".m", ".mm", ".c"] libs = find (specLibDirectory spec) ".a" - config = readConfig spec - prefix = readHeader spec - in KitContents (specKit spec) <$> headers <*> sources <*> libs <*> config <*> prefix + config = liftIO $ readConfig (base kitDir) spec + prefix = liftIO $ readHeader (base kitDir) spec + resourceDir = liftIO $ do + let r = base kitDir specResourcesDirectory spec + b <- doesDirectoryExist r + if b then + Just <$> canonicalizePath r + else + return Nothing + in KitContents spec <$> headers <*> sources <*> libs <*> config <*> prefix <*> resourceDir -- TODO report missing file -readHeader :: KitSpec -> IO (Maybe String) -readHeader spec = do - let fp = packageFileName spec specPrefixFile spec +readHeader :: FilePath -> KitSpec -> IO (Maybe String) +readHeader kitDir spec = do + let fp = kitDir specPrefixFile spec exists <- doesFileExist fp T.sequence (fmap readFile $ ifTrue exists fp) -- TODO report missing file -readConfig :: KitSpec -> IO (Maybe XCConfig) -readConfig spec = do - let fp = packageFileName spec specConfigFile spec +readConfig :: FilePath -> KitSpec -> IO (Maybe XCConfig) +readConfig kitDir spec = do + let fp = kitDir specConfigFile spec exists <- doesFileExist fp contents <- T.sequence (fmap readFile $ ifTrue exists fp) return $ fmap (fileContentsToXCC $ packageName spec) contents diff --git a/Kit/Dependency.hs b/Kit/Dependency.hs new file mode 100644 --- /dev/null +++ b/Kit/Dependency.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE TupleSections #-} +module Kit.Dependency ( + totalSpecDependencies, + Dependency(..), + depSpec, + isDevDep, + dependencyTree, + devKitDir -- TODO, cleanup main, might not need to export + ) where + +import Kit.Util +import Kit.Spec +import Kit.Repository +import Kit.WorkingCopy +import Data.Tree +import Data.List + +data Dependency = Dep KitSpec | Dev KitSpec FilePath deriving (Eq, Show) + +depSpec (Dep k) = k +depSpec (Dev k _) = k + +isDevDep :: Dependency -> Bool +isDevDep (Dep _) = False +isDevDep (Dev _ _) = True + +-- | Return all the (unique) children of this tree (except the top node), in reverse depth order. +refineDeps :: Eq a => Tree a -> [a] +refineDeps = nub . concat . reverse . drop 1 . levels + +-- todo: check for conflicts +-- todo: check for version ranges :) +totalSpecDependencies :: KitRepository -> WorkingCopy -> KitIO [Dependency] +totalSpecDependencies repo workingCopy = refineDeps <$> dependencyTree repo workingCopy + +dependencyTree :: KitRepository -> WorkingCopy -> KitIO (Tree Dependency) +dependencyTree repo workingCopy = unfoldTreeM (unfoldDeps repo) (workingKitSpec workingCopy) + +unfoldDeps :: KitRepository -> KitSpec -> KitIO (Dependency, [KitSpec]) +unfoldDeps kr ks = (Dep ks,) <$> mapM (readKitSpec kr) (specDependencies ks) + diff --git a/Kit/Main.hs b/Kit/Main.hs --- a/Kit/Main.hs +++ b/Kit/Main.hs @@ -7,37 +7,44 @@ import Kit.Package import Kit.Project import Kit.Util + import Kit.Contents + import Kit.Dependency + import Kit.WorkingCopy import System.Cmd import System.Exit import Data.Tree (drawTree) + import Data.List (partition) + import Kit.Repository (unpackKit, packagesDirectory, publishLocally) - import System.Console.ANSI - - say :: MonadIO m => Color -> String -> m () - say color msg = do - liftIO $ setSGR [SetColor Foreground Vivid color] - puts msg - liftIO $ setSGR [] + f2 spec = do + base <- liftIO $ canonicalizePath devKitDir + readKitContents' base packageName spec - alert :: MonadIO m => String -> m () - alert = say Red + f1 packagesDirectory spec = do + base <- liftIO $ canonicalizePath packagesDirectory + readKitContents' base packageFileName spec doUpdate :: Command () doUpdate = do repo <- myRepository - spec <- mySpec - deps <- liftKit $ totalSpecDependencies repo spec - liftIO $ mapM_ (unpackKit repo . specKit) deps + workingCopy <- myWorkingCopy + let spec = workingKitSpec workingCopy + deps <- liftKit $ totalSpecDependencies repo workingCopy + let (devPackages, notDevPackages) = partition isDevDep deps + liftIO $ mapM_ ((unpackKit repo . specKit) . depSpec) notDevPackages + liftIO $ mapM_ (\s -> say Red $ " -> Using dev package: " ++ packageName (depSpec s)) devPackages puts " -> Generating Xcode project..." - liftKit $ generateKitProjectFromSpecs deps (specKitDepsXcodeFlags spec) + devSpecs <- mapM (f2 . depSpec) devPackages + notDevSpecs <- mapM (f1 (packagesDirectory repo) . depSpec) notDevPackages + liftKit $ writeKitProjectFromContents (devSpecs ++ notDevSpecs) (specKitDepsXcodeFlags spec) (packagesDirectory repo) say Green "\n\tKit complete. You may need to restart Xcode for it to pick up any changes.\n" doShowTree :: Command () doShowTree = do repo <- myRepository - spec <- mySpec - tree <- liftKit $ dependencyTree repo spec - liftIO $ putStrLn $ drawTree $ fmap packageFileName $ tree + wc <- myWorkingCopy + tree <- liftKit $ dependencyTree repo wc + liftIO $ putStrLn $ drawTree $ fmap (packageFileName . depSpec) tree doPackageKit :: Command () doPackageKit = mySpec >>= liftIO . package @@ -45,21 +52,13 @@ doPublishLocal :: Maybe String -> Command () doPublishLocal versionTag = do spec <- mySpec - specFile <- mySpecFile + specFile <- workingSpecFile <$> myWorkingCopy + repo <- myRepository let updatedSpec = maybe spec (\tag -> updateVersion spec (++tag)) versionTag liftIO $ do package updatedSpec - publishLocal updatedSpec specFile + publishLocally repo updatedSpec specFile $ "dist" packageFileName updatedSpec ++ ".tar.gz" return () - where - publishLocal :: KitSpec -> FilePath -> IO () - publishLocal spec specFile = let pkg = (packageFileName spec ++ ".tar.gz") - in do - repo <- defaultLocalRepoPath - let thisKitDir = repo "kits" packageName spec packageVersion spec - mkdirP thisKitDir - copyFile ("dist" pkg) (thisKitDir pkg) - copyFile specFile (thisKitDir "KitSpec") doVerify :: String -> Command () doVerify sdk = do @@ -96,10 +95,20 @@ handleArgs KA.ShowTree = doShowTree kitMain :: IO () - kitMain = let f = do - mkdirP =<< defaultLocalRepoPath - runCommand . handleArgs =<< KA.parseArgs - in catch f $ \e -> do - alert $ show e - exitWith $ ExitFailure 1 + kitMain = do + let f = runCommand . handleArgs =<< KA.parseArgs + h <- getHomeDirectory + fs <- inDirectory h $ glob ".kit/repository/kits/*/*/*.tar.gz" + let c = length fs + when (c > 0) $ do + say Red $ "Warning: Kit now expects packages in '.kit/cache/local' instead of '.kit/repository/kits'. (Found " ++ show c ++ " packages in the old location.)" + puts "" + say Red "To fix it, move the old directory into the new path:" + say Red "\t$ mkdir -p ~/.kit/cache/local" + say Red "\t$ mv ~/.kit/repository/kits/* ~/.kit/cache/local" + say Red "\t$ rmdir ~/.kit/repository/kits && rmdir ~/.kit/repository" + puts "" + catch f $ \e -> do + alert $ show e + exitWith $ ExitFailure 1 diff --git a/Kit/Project.hs b/Kit/Project.hs --- a/Kit/Project.hs +++ b/Kit/Project.hs @@ -1,15 +1,11 @@ {-# LANGUAGE TupleSections #-} module Kit.Project ( - totalSpecDependencies, - unpackKit, - generateKitProjectFromSpecs, - dependencyTree + writeKitProjectFromContents ) where import Kit.Spec import Kit.Contents -import Kit.Repository import Kit.Util import Kit.Util.FSAction import Kit.Xcode.Builder @@ -17,14 +13,11 @@ import Control.Monad.Error import Data.Maybe -import Data.List import qualified Data.Map as M -import Data.Tree -import System.Cmd -- Paths -kitDir, projectDir, prefixFile, projectFile, xcodeConfigFile, depsConfigFile, kitUpdateMakeFilePath :: FilePath +kitDir, projectDir, prefixFile, projectFile, xcodeConfigFile, depsConfigFile, kitUpdateMakeFilePath, kitResourceDir :: FilePath kitDir = "." "Kits" projectDir = "KitDeps.xcodeproj" @@ -33,6 +26,7 @@ xcodeConfigFile = "Kit.xcconfig" depsConfigFile = "DepsOnly.xcconfig" kitUpdateMakeFilePath = "Makefile" +kitResourceDir = "Resources" kitUpdateMakeFile :: String kitUpdateMakeFile = "kit: Kit.xcconfig\n" ++ @@ -53,34 +47,39 @@ kitProjectResourceDirs :: [(FilePath, FilePath)] } deriving (Eq, Show) -generateKitProject :: KitProject -> KitIO () -generateKitProject kp = liftIO $ inDirectory kitDir $ do - runAction $ FileCreate projectFile $ kitProjectFile kp - runAction $ FileCreate prefixFile $ kitProjectPrefix kp - runAction $ FileCreate xcodeConfigFile $ kitProjectConfig kp - runAction $ FileCreate kitUpdateMakeFilePath kitUpdateMakeFile - runAction $ FileCreate depsConfigFile $ kitProjectDepsConfig kp - when (not . null . kitProjectResourceDirs $ kp) $ do - puts $ " -> Linking resources: " ++ stringJoin ", " (map fst $ kitProjectResourceDirs kp) - mapM_ (\(tgt,name) -> runAction $ Symlink tgt name) $ kitProjectResourceDirs kp +writeKitProjectFromContents :: [KitContents] -> Maybe String -> FilePath -> KitIO () +writeKitProjectFromContents contents depsOnlyConfig packagesDirectory = writeKitProject $ makeKitProject contents depsOnlyConfig packagesDirectory -generateKitProjectFromSpecs :: [KitSpec] -> Maybe String -> KitIO () -generateKitProjectFromSpecs specs depsOnlyConfig = do - kp <- generateXcodeProject specs depsOnlyConfig - generateKitProject kp +writeKitProject :: KitProject -> KitIO () +writeKitProject kp = do + liftIO $ mapM_ (runAction . within kitDir) [ + FileCreate projectFile (kitProjectFile kp), + FileCreate prefixFile (kitProjectPrefix kp), + FileCreate xcodeConfigFile (kitProjectConfig kp), + FileCreate kitUpdateMakeFilePath kitUpdateMakeFile, + FileCreate depsConfigFile (kitProjectDepsConfig kp) + ] + mkdirP kitDir + liftIO $ inDirectory kitDir $ do + let resourceDirs = kitProjectResourceDirs kp + unless (null resourceDirs) $ do + puts $ " -> Linking resources: " ++ stringJoin ", " (map fst resourceDirs) + mapM_ (\(tgt,name) -> runAction $ Symlink tgt name) resourceDirs -generateXcodeProject :: [KitSpec] -> Maybe String -> KitIO KitProject -generateXcodeProject specs depsOnlyConfig = do - liftIO $ inDirectory kitDir $ do - currentDir <- getCurrentDirectory - kitsContents <- mapM (fmap (makeContentsRelative currentDir) . readKitContents) specs - let pf = createProjectFile kitsContents - let header = createHeader kitsContents - let config = createConfig kitsContents - -- TODO: Make this specify an xcconfig - let depsConfig = "#include \"" ++ xcodeConfigFile ++ "\"\n\nSKIP_INSTALL=YES\n\n" ++ fromMaybe "" depsOnlyConfig - resources <- filterM (doesDirectoryExist . fst) $ map resourceLink specs - return $ KitProject pf header config depsConfig resources +resourceLink :: KitContents -> Maybe (FilePath, FilePath) +resourceLink contents = let specResources = contentResourceDir contents + linkName = kitResourceDir packageName (contentSpec contents) + in (,linkName) <$> specResources + +makeKitProject :: [KitContents] -> Maybe String -> FilePath -> KitProject +makeKitProject kitsContents depsOnlyConfig packagesDirectory = + let pf = createProjectFile kitsContents + header = createHeader kitsContents + config = createConfig kitsContents + -- TODO: Make this specify an xcconfig + depsConfig = "#include \"" ++ xcodeConfigFile ++ "\"\n\nSKIP_INSTALL=YES\n\n" ++ fromMaybe "" depsOnlyConfig + resources = mapMaybe resourceLink kitsContents + in KitProject pf header config depsConfig resources where createProjectFile cs = do let headers = concatMap contentHeaders cs let sources = concatMap contentSources cs @@ -91,7 +90,7 @@ let combinedHeader = stringJoin "\n" headers prefixDefault ++ combinedHeader ++ "\n" createConfig cs = do - let sourceDirs = map (\spec -> packageFileName spec specSourceDirectory spec) specs >>= (\s -> [s, kitDir s]) + let sourceDirs = map ((\spec -> packageFileName spec specSourceDirectory spec) . contentSpec) cs >>= (\s -> [s, packagesDirectory s]) let configs = mapMaybe contentConfig cs let parentConfig = XCC "Base" (M.fromList [ ("HEADER_SEARCH_PATHS", "$(HEADER_SEARCH_PATHS) " ++ stringJoin " " sourceDirs), @@ -100,35 +99,4 @@ ]) [] let combinedConfig = multiConfig "KitConfig" (parentConfig:configs) configToString combinedConfig ++ "\n" - -resourceLink :: KitSpec -> (FilePath, FilePath) -resourceLink spec = - let specResources = packageFileName spec specResourcesDirectory spec - linkName = "Resources" packageName spec - in (specResources, linkName) - --- | Return all the (unique) children of this tree (except the top node), in reverse depth order. -refineDeps :: Eq a => Tree a -> [a] -refineDeps = nub . concat . reverse . drop 1 . levels - --- todo: check for conflicts --- todo: check for version ranges :) -totalSpecDependencies :: KitRepository -> KitSpec -> KitIO [KitSpec] -totalSpecDependencies kr spec = refineDeps <$> unfoldTreeM (unfoldDeps kr) spec - -dependencyTree :: KitRepository -> KitSpec -> KitIO (Tree KitSpec) -dependencyTree kr spec = unfoldTreeM (unfoldDeps kr) spec - -unfoldDeps :: KitRepository -> KitSpec -> KitIO (KitSpec, [KitSpec]) -unfoldDeps kr ks = (ks,) <$> mapM (readKitSpec kr) (specDependencies ks) -- s/mapM/traverse ? - -unpackKit :: KitRepository -> Kit -> IO () -unpackKit kr kit = do - tmpDir <- getTemporaryDirectory - let fp = tmpDir (packageFileName kit ++ ".tar.gz") - putStrLn $ " -> Installing " ++ packageFileName kit - copyKitPackage kr kit fp - mkdirP kitDir - inDirectory kitDir $ system ("tar zxf " ++ fp) - return () diff --git a/Kit/Repository.hs b/Kit/Repository.hs --- a/Kit/Repository.hs +++ b/Kit/Repository.hs @@ -1,11 +1,15 @@ {-# LANGUAGE PackageImports #-} module Kit.Repository ( -- - KitRepository(KitRepository), + KitRepository, + makeRepository, -- copyKitPackage, explodePackage, - readKitSpec + readKitSpec, + unpackKit, + packagesDirectory, + publishLocally ) where import Kit.Spec @@ -17,36 +21,74 @@ import qualified Data.Traversable as T import qualified Data.ByteString as BS - data KitRepository = KitRepository { repositoryBase :: FilePath } deriving (Eq, Show) + data KitRepository = KitRepository { dotKitDir :: FilePath } deriving (Eq, Show) + localCacheDir :: KitRepository -> FilePath + localCacheDir kr = dotKitDir kr "cache" "local" + + makeRepository :: FilePath -> IO KitRepository + makeRepository fp = do + let kr = KitRepository fp + mkdirP $ localCacheDir kr + return kr + explodePackage :: KitRepository -> Kit -> IO () explodePackage kr kit = do - let packagesDir = repositoryBase kr "kits" - let packagePath = repositoryBase kr kitPackagePath kit + let packagesDir = localCacheDir kr + let packagePath = localCacheDir kr kitPackagePath kit mkdirP packagesDir inDirectory packagesDir $ system ("tar zxvf " ++ packagePath) return () copyKitPackage :: KitRepository -> Kit -> FilePath -> IO () - copyKitPackage repo kit destPath = copyFile (repositoryBase repo kitPackagePath kit) destPath + copyKitPackage repo kit = copyFile (localCacheDir repo kitPackagePath kit) readKitSpec :: KitRepository -> Kit -> KitIO KitSpec readKitSpec repo kit = do - mbKitStuff <- liftIO $ doRead repo (kitSpecPath kit) + mbKitStuff <- liftIO $ readIfExists (localCacheDir repo kitSpecPath kit) maybe (throwError $ "Missing " ++ packageFileName kit) f mbKitStuff where f contents = maybeToKitIO ("Invalid KitSpec file for " ++ packageFileName kit) $ decodeSpec contents - doRead :: KitRepository -> String -> IO (Maybe BS.ByteString) - doRead (KitRepository baseDir) fp = let file = (baseDir fp) in do + readIfExists :: String -> IO (Maybe BS.ByteString) + readIfExists file = do exists <- doesFileExist file T.sequenceA $ ifTrue exists $ BS.readFile file baseKitPath :: Kit -> String - baseKitPath k = stringJoin "/" ["kits", kitName k, kitVersion k] + baseKitPath k = kitName k kitVersion k kitPackagePath :: Kit -> String - kitPackagePath k = baseKitPath k ++ "/" ++ packageFileName k ++ ".tar.gz" + kitPackagePath k = baseKitPath k packageFileName k ++ ".tar.gz" kitSpecPath :: Kit -> String - kitSpecPath k = baseKitPath k ++ "/" ++ "KitSpec" + kitSpecPath k = baseKitPath k "KitSpec" + + packagesDirectory :: KitRepository -> FilePath + packagesDirectory kr = dotKitDir kr "packages" + + unpackKit :: KitRepository -> Kit -> IO () + unpackKit kr kit = do + let source = (localCacheDir kr kitPackagePath kit) + let dest = packagesDirectory kr + d <- doesDirectoryExist $ dest packageFileName kit + if not d then do + putStrLn $ " -> Unpacking from cache: " ++ packageFileName kit + mkdirP dest + inDirectory dest $ system ("tar zxf " ++ source) + return () + else + putStrLn $ " -> Using local package: " ++ packageFileName kit + return () + + -- TODO: on publish local, need to flush this particular name/version out + -- of the packages dir if it exists, so if this is overriding a version, that + -- all works. + publishLocally :: KitRepository -> KitSpec -> FilePath -> FilePath -> IO () + publishLocally kr ks specFile packageFile = do + let cacheDir = localCacheDir kr + let thisKitDir = cacheDir baseKitPath (specKit ks) + mkdirP thisKitDir + let fname = takeFileName packageFile + copyFile packageFile (thisKitDir fname) + copyFile specFile (thisKitDir "KitSpec") diff --git a/Kit/Spec.hs b/Kit/Spec.hs --- a/Kit/Spec.hs +++ b/Kit/Spec.hs @@ -22,6 +22,8 @@ import Kit.Util.IsObject import qualified Data.ByteString as BS import qualified Data.Object.Yaml as Y + import Data.Maybe (maybeToList) + import Control.Arrow ((&&&)) data KitSpec = KitSpec { specKit :: Kit, @@ -63,7 +65,7 @@ -- TODO make this and the json reading use the same defaults -- I suspect that to do this I'll need update functions for each of -- fields in the KitSpec record. - -- Look at the 'lenses' package on hackage. + -- Look at the 'lenses' package on hackage. (or comonad-transformers) decodeSpec :: BS.ByteString -> Maybe KitSpec decodeSpec s = Y.decode s >>= readObject @@ -81,20 +83,28 @@ readObject x = fromMapping x >>= \obj -> (Kit <$> obj #> "name" <*> obj #> "version") <|> case obj of [(key, Scalar value)] -> Just $ Kit key value -- TODO this + ReadObject should be identity + -- TODO don't write out default values instance ShowObject KitSpec where - showObject spec = Mapping [ - "name" ~> (val $ kitName . specKit), - "version" ~> (val $ kitVersion . specKit), - "dependencies" ~> showObject (specDependencies spec), - "source-directory" ~> val specSourceDirectory - ] where a ~> b = (a, b) - val f = Scalar . f $ spec + showObject spec = Mapping ([ + "name" ~> val (kitName . specKit), + "version" ~> val (kitVersion . specKit), + "dependencies" ~> Sequence (map makeDep (specDependencies spec)), + "source-directory" ~> val specSourceDirectory, + "test-directory" ~> val specTestDirectory, + "lib-directory" ~> val specLibDirectory, + "resources-directory" ~> val specResourcesDirectory, + "prefix-header" ~> val specPrefixFile, + "xcconfig" ~> val specConfigFile + ] ++ maybeToList (fmap (("kitdeps-xcode-flags" ~>) . Scalar) (specKitDepsXcodeFlags spec))) + where a ~> b = (a, b) + val f = Scalar . f $ spec + makeDep dep = Mapping [(kitName dep, Scalar $ kitVersion dep)] instance ReadObject KitSpec where readObject x = fromMapping x >>= parser where or' a b = a <|> pure b parser obj = KitSpec <$> readObject x - <*> (obj #> "dependencies" `or'` []) + <*> (obj #> "dependencies" `or'` []) -- TODO this should fail if it can't read the format <*> (obj #> "source-directory" `or'` "src") <*> (obj #> "test-directory" `or'` "test") <*> (obj #> "lib-directory" `or'` "lib") diff --git a/Kit/Util.hs b/Kit/Util.hs --- a/Kit/Util.hs +++ b/Kit/Util.hs @@ -5,7 +5,8 @@ module Control.Applicative, module Control.Monad, module System.Directory, - module System.FilePath.Posix + module System.FilePath.Posix, + Color(..) ) where import System.Directory import System.FilePath.Posix @@ -14,13 +15,16 @@ import Data.List import Data.Maybe import Data.Monoid + import Data.Traversable as T import Control.Applicative import Control.Monad - import Control.Monad.Error + import "mtl" Control.Monad.Error - import qualified Control.Monad.State as S + import System.Console.ANSI + import qualified "mtl" Control.Monad.State as S + popS :: S.State [a] a popS = do (x:t) <- S.get @@ -73,3 +77,22 @@ stringJoin :: Monoid a => a -> [a] -> a stringJoin x = mconcat . intersperse x + -- | Lifting bind into a monad. Often denoted /concatMapM/. + (.=<<.) :: + (Monad q, Monad m, Traversable m) => + (a -> q (m b)) + -> m a + -> q (m b) + (.=<<.) f = + liftM join . T.mapM f + + + say :: MonadIO m => Color -> String -> m () + say color msg = do + liftIO $ setSGR [SetColor Foreground Vivid color] + puts msg + liftIO $ setSGR [] + + alert :: MonadIO m => String -> m () + alert = say Red + diff --git a/Kit/WorkingCopy.hs b/Kit/WorkingCopy.hs new file mode 100644 --- /dev/null +++ b/Kit/WorkingCopy.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE PackageImports, TupleSections #-} +module Kit.WorkingCopy ( + WorkingCopy(..), + currentWorkingCopy, + isDevPackage, + devKitDir + ) where + +import Kit.Util +import Kit.Spec + +import "mtl" Control.Monad.Trans +import "mtl" Control.Monad.Error +import qualified Data.ByteString as BS + +devKitDir :: String +devKitDir = "dev-packages" + +data WorkingCopy = WorkingCopy { + workingKitSpec :: KitSpec, + workingSpecFile :: FilePath, + workingDevPackages :: [(FilePath, KitSpec)] +} deriving (Eq, Show) + +currentWorkingCopy :: KitIO WorkingCopy +currentWorkingCopy = do + let specFile = "KitSpec" + spec <- readSpec specFile + devKitSpecFiles <- liftIO $ glob "dev-packages/*/KitSpec" + let f path = (takeFileName . takeDirectory $ path,) <$> readSpec path + devKitSpecs <- mapM f devKitSpecFiles + return $ WorkingCopy spec specFile devKitSpecs + +isDevPackage :: WorkingCopy -> KitSpec -> Bool +isDevPackage wc spec = any (\s -> packageName spec == packageName s) $ map snd (workingDevPackages wc) + +readSpec :: FilePath -> KitIO KitSpec +readSpec path = checkExists path >>= liftIO . BS.readFile >>= ErrorT . return . parses + where checkExists pathToSpec = do + doesExist <- liftIO $ doesFileExist pathToSpec + if doesExist then return pathToSpec else throwError $ "Couldn't find the spec at " ++ pathToSpec + parses = maybeToRight "Parse error in KitSpec file" . decodeSpec + diff --git a/Kit/Xcode/Common.hs b/Kit/Xcode/Common.hs --- a/Kit/Xcode/Common.hs +++ b/Kit/Xcode/Common.hs @@ -46,13 +46,14 @@ fileReferenceItem fr = fileReferenceId fr ~> dict where fileName = fileReferenceName fr + path = fileReferencePath fr dict = obj [ "isa" ~> val "PBXFileReference", "fileEncoding" ~> val "4", "lastKnownFileType" ~> val (fileType fileName), "name" ~> val fileName, - "path" ~> val (fileReferencePath fr), - "sourceTree" ~> val "" + "path" ~> val path, + "sourceTree" ~> val (if (isAbsolute path) then "") ] fileReferenceName :: PBXFileReference -> String diff --git a/kit.cabal b/kit.cabal --- a/kit.cabal +++ b/kit.cabal @@ -1,5 +1,5 @@ name: kit -version: 0.6.8 +version: 0.7.0 cabal-version: >=1.2 build-type: Simple license: BSD3 @@ -23,5 +23,6 @@ hs-source-dirs: . other-modules: Kit.Spec Kit.Main Kit.Package Kit.Project Kit.Repository Kit.Util Kit.Xcode.Builder Kit.Xcode.Common Kit.Xcode.ProjectFileTemplate Kit.Xcode.XCConfig Text.PList - Kit.Contents Kit.Commands Kit.CmdArgs Kit.Util.IsObject Kit.Util.FSAction + Kit.Contents Kit.Commands Kit.CmdArgs Kit.Util.IsObject Kit.Util.FSAction Kit.WorkingCopy + Kit.Dependency Ghc-options: -Wall -fno-warn-unused-do-bind