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.5" -- TODO how to keep this up to date with kit.cabal? + appVersion = "0.6.6" -- 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,6 +3,7 @@ Command, liftKit, mySpec, + mySpecFile, myRepository, runCommand, defaultLocalRepoPath, @@ -32,6 +33,9 @@ myRepository :: Command KitRepository myRepository = Command $ fmap snd ask + +mySpecFile :: Command FilePath +mySpecFile = return "KitSpec" runCommand :: Command a -> IO () runCommand (Command cmd) = run $ do diff --git a/Kit/Main.hs b/Kit/Main.hs --- a/Kit/Main.hs +++ b/Kit/Main.hs @@ -8,17 +8,28 @@ import Kit.Project import Kit.Util import System.Cmd + import System.Exit + import System.Console.ANSI + + 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 + doUpdate :: Command () doUpdate = do repo <- myRepository spec <- mySpec deps <- liftKit $ totalSpecDependencies repo spec - puts $ "Dependencies: " ++ stringJoin ", " (map packageFileName deps) liftIO $ mapM_ (unpackKit repo . specKit) deps puts " -> Generating Xcode project..." - liftKit $ generateXcodeProject deps (specKitDepsXcodeFlags spec) - puts "Kit complete. You may need to restart Xcode for it to pick up any changes." + liftKit $ generateKitProjectFromSpecs deps (specKitDepsXcodeFlags spec) + say Green "\n\tKit complete. You may need to restart Xcode for it to pick up any changes.\n" doPackageKit :: Command () doPackageKit = mySpec >>= liftIO . package @@ -26,20 +37,21 @@ doPublishLocal :: Maybe String -> Command () doPublishLocal versionTag = do spec <- mySpec + specFile <- mySpecFile let updatedSpec = maybe spec (\tag -> updateVersion spec (++tag)) versionTag liftIO $ do package updatedSpec - publishLocal updatedSpec + publishLocal updatedSpec specFile return () where - publishLocal :: KitSpec -> IO () - publishLocal spec = let pkg = (packageFileName spec ++ ".tar.gz") + 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) - writeSpec (thisKitDir "KitSpec") spec + copyFile specFile (thisKitDir "KitSpec") doVerify :: String -> Command () doVerify sdk = do @@ -75,7 +87,10 @@ handleArgs (KA.CreateSpec name version) = doCreateSpec name version kitMain :: IO () - kitMain = do - mkdirP =<< defaultLocalRepoPath - runCommand . handleArgs =<< KA.parseArgs + kitMain = let f = do + mkdirP =<< defaultLocalRepoPath + runCommand . handleArgs =<< KA.parseArgs + in 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 @@ -2,7 +2,7 @@ module Kit.Project ( totalSpecDependencies, unpackKit, - generateXcodeProject + generateKitProjectFromSpecs ) where @@ -17,9 +17,9 @@ import Control.Monad.Error import Data.Maybe import Data.List +import qualified Data.Map as M import Data.Tree import System.Cmd -import System.Posix.Files -- Paths @@ -44,47 +44,65 @@ " #import \n" ++ "#endif\n" -generateXcodeProject :: [KitSpec] -> Maybe String -> KitIO () +data KitProject = KitProject { + kitProjectFile :: String, + kitProjectPrefix :: String, + kitProjectConfig :: String, + kitProjectDepsConfig :: String, + 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 + puts $ " -> Linking resources: " ++ stringJoin ", " (map fst $ kitProjectResourceDirs kp) + mapM_ (\(tgt,name) -> runAction $ Symlink tgt name) $ kitProjectResourceDirs kp + +generateKitProjectFromSpecs :: [KitSpec] -> Maybe String -> KitIO () +generateKitProjectFromSpecs specs depsOnlyConfig = do + kp <- generateXcodeProject specs depsOnlyConfig + generateKitProject kp + +generateXcodeProject :: [KitSpec] -> Maybe String -> KitIO KitProject generateXcodeProject specs depsOnlyConfig = do liftIO $ inDirectory kitDir $ do kitsContents <- mapM readKitContents specs - runAction $ createProjectFile kitsContents - runAction $ createHeader kitsContents - runAction $ createConfig kitsContents - runAction $ FileCreate kitUpdateMakeFilePath kitUpdateMakeFile - runAction $ FileCreate depsConfigFile $ "#include \"" ++ xcodeConfigFile ++ "\"\n" ++ fromMaybe "" depsOnlyConfig - symlinkAll 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 where createProjectFile cs = do let headers = concatMap contentHeaders cs let sources = concatMap contentSources cs let libs = concatMap contentLibs cs - FileCreate projectFile $ renderXcodeProject headers sources libs "libKitDeps.a" + renderXcodeProject headers sources libs "libKitDeps.a" createHeader cs = do let headers = mapMaybe namedPrefix cs let combinedHeader = stringJoin "\n" headers - FileCreate prefixFile $ prefixDefault ++ combinedHeader ++ "\n" + prefixDefault ++ combinedHeader ++ "\n" createConfig cs = do let sourceDirs = map (\spec -> packageFileName spec specSourceDirectory spec) specs >>= (\s -> [s, kitDir s]) let configs = mapMaybe contentConfig cs - let combinedConfig = multiConfig "KitConfig" configs - let kitHeaders = "HEADER_SEARCH_PATHS = $(HEADER_SEARCH_PATHS) " ++ stringJoin " " sourceDirs - let prefixHeaders = "GCC_PRECOMPILE_PREFIX_HEADER = YES\nGCC_PREFIX_HEADER = $(SRCROOT)/Prefix.pch\n" - FileCreate xcodeConfigFile $ kitHeaders ++ "\n" ++ prefixHeaders ++ "\n" ++ configToString combinedConfig ++ "\n" - -symlinkAll :: [KitSpec] -> IO () -symlinkAll specs = do - mkdirP "Resources" - mapM_ symlinkResources specs + let parentConfig = XCC "Base" (M.fromList [ + ("HEADER_SEARCH_PATHS", "$(HEADER_SEARCH_PATHS) " ++ stringJoin " " sourceDirs), + ("GCC_PRECOMPILE_PREFIX_HEADER", "YES"), + ("GCC_PREFIX_HEADER","$(SRCROOT)/Prefix.pch") + ]) [] + let combinedConfig = multiConfig "KitConfig" (parentConfig:configs) + configToString combinedConfig ++ "\n" -symlinkResources :: KitSpec -> IO () -symlinkResources spec = do - let resourcesDir = packageFileName spec specResourcesDirectory spec - let linkName = "Resources" packageName spec - when' (fileExist linkName) $ removeLink linkName - when' (doesDirectoryExist resourcesDir) $ do - puts $ "-> Linking resources in " ++ resourcesDir - -- symbolic link target paths are relative to the the link - createSymbolicLink (".." resourcesDir) linkName +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] diff --git a/Kit/Spec.hs b/Kit/Spec.hs --- a/Kit/Spec.hs +++ b/Kit/Spec.hs @@ -74,13 +74,15 @@ writeSpec :: MonadIO m => FilePath -> KitSpec -> m () writeSpec fp spec = liftIO $ BS.writeFile fp $ encodeSpec spec - instance IsObject Kit where + instance ShowObject Kit where showObject kit = Mapping [("name", w kitName), ("version", w kitVersion)] where w f = showObject . f $ kit + + instance ReadObject Kit where readObject x = fromMapping x >>= \obj -> (Kit <$> obj #> "name" <*> obj #> "version") <|> case obj of [(key, Scalar value)] -> Just $ Kit key value _ -> Nothing - instance IsObject KitSpec where + instance ShowObject KitSpec where showObject spec = Mapping [ "name" ~> (val $ kitName . specKit), "version" ~> (val $ kitVersion . specKit), @@ -89,6 +91,7 @@ ] where a ~> b = (a, b) val f = Scalar . f $ spec + instance ReadObject KitSpec where readObject x = fromMapping x >>= parser where or' a b = a <|> pure b parser obj = KitSpec <$> readObject x diff --git a/Kit/Util/FSAction.hs b/Kit/Util/FSAction.hs --- a/Kit/Util/FSAction.hs +++ b/Kit/Util/FSAction.hs @@ -4,6 +4,7 @@ import System.Posix.Files import Kit.Util +import Data.List (intersperse) data FSAction = FileCreate FilePath String @@ -19,8 +20,13 @@ mkdirP $ dropFileName atPath writeFile atPath contents runAction (Symlink target name) = do - when' (fileExist name) $ removeLink name - createSymbolicLink target name + catch (removeLink name) (\_ -> return ()) + -- When a `name` has parent directories, symbolic link target needs to be made relative to that file + -- need to consider "./name" + let relFix = join $ intersperse "/" $ map (const "..") (init $ splitDirectories name) + catch (when' (fileExist target) $ createSymbolicLink (relFix target) name) $ \e -> do + error $ "An error occured when creating a symlink to " ++ target ++ " called " ++ name ++ ": " ++ show e + runAction (InDir dir action) = do mkdirP dir inDirectory dir $ runAction action diff --git a/Kit/Util/IsObject.hs b/Kit/Util/IsObject.hs --- a/Kit/Util/IsObject.hs +++ b/Kit/Util/IsObject.hs @@ -2,18 +2,24 @@ module Kit.Util.IsObject where import Data.Object - class IsObject x where + class ShowObject x where showObject :: x -> StringObject + + class ReadObject x where readObject :: StringObject -> Maybe x - (#>) :: IsObject b => [(String, Object String String)] -> String -> Maybe b + (#>) :: ReadObject b => [(String, Object String String)] -> String -> Maybe b obj #> key = lookupObject key obj >>= readObject - instance IsObject a => IsObject [a] where + instance ShowObject a => ShowObject [a] where showObject xs = Sequence $ map showObject xs + + instance ReadObject a => ReadObject [a] where readObject x = fromSequence x >>= mapM readObject - instance IsObject String where + instance ShowObject String where showObject = Scalar + + instance ReadObject String where readObject = fromScalar diff --git a/Kit/Xcode/XCConfig.hs b/Kit/Xcode/XCConfig.hs --- a/Kit/Xcode/XCConfig.hs +++ b/Kit/Xcode/XCConfig.hs @@ -16,7 +16,6 @@ configSettings :: M.Map String String, configIncludes :: [XCCInclude] } deriving (Eq, Show) - includeStart :: String includeStart = "#include " diff --git a/kit.cabal b/kit.cabal --- a/kit.cabal +++ b/kit.cabal @@ -1,5 +1,5 @@ name: kit -version: 0.6.5 +version: 0.6.6 cabal-version: >=1.2 build-type: Simple license: BSD3 @@ -18,7 +18,7 @@ filepath -any, directory -any, containers -any, cmdargs >=0.3, bytestring -any, base >=3 && <5, HTTP >=4000.0.9, Glob >= 0.5, data-object -any, data-object-yaml -any, - unix >= 2.4 && < 2.5 + unix >= 2.4 && < 2.5, ansi-terminal >= 0.5.5 hs-source-dirs: . other-modules: Kit.Spec Kit.Main Kit.Package Kit.Project Kit.Repository Kit.Util Kit.Xcode.Builder