diff --git a/Kit/JSON.hs b/Kit/JSON.hs --- a/Kit/JSON.hs +++ b/Kit/JSON.hs @@ -29,3 +29,7 @@ in KitSpec <$> myKit <*> myConfig where f x = mLookup x jsonObjAssoc >>= readJSON jsonObjAssoc = fromJSObject obj + + mLookup :: Monad m => String -> [(String, b)] -> m b + mLookup a as = maybe (fail $ "No such element: " ++ a) return (lookup a as) + diff --git a/Kit/Kit.hs b/Kit/Kit.hs --- a/Kit/Kit.hs +++ b/Kit/Kit.hs @@ -1,9 +1,11 @@ module Kit.Kit where import Kit.Util + type Version = String + data Kit = Kit { kitName :: String, - kitVersion :: String + kitVersion :: Version } deriving (Eq, Show, Ord, Read) kitFileName :: Kit -> String diff --git a/Kit/Main.hs b/Kit/Main.hs --- a/Kit/Main.hs +++ b/Kit/Main.hs @@ -35,9 +35,8 @@ puts $ "Dependencies: " ++ (stringJoin ", " $ map kitFileName deps) liftIO $ mapM (installKit repo) deps puts " -> Generating XCode project..." - liftIO $ generateXCodeProject $ deps |> kitFileName - liftIO $ generateXCodeConfig $ deps |> kitFileName - puts "Kit complete." + liftIO $ generateXCodeProject deps + puts "Kit complete. You may need to restart XCode for it to pick up any changes." where p x = liftIO $ print x puts x = liftIO $ putStrLn x diff --git a/Kit/Project.hs b/Kit/Project.hs --- a/Kit/Project.hs +++ b/Kit/Project.hs @@ -2,7 +2,6 @@ getDeps, getMyDeps, installKit, - generateXCodeConfig, generateXCodeProject, myKitSpec) where @@ -21,52 +20,77 @@ import Kit.Spec import Kit.XCode.Builder import Kit.XCode.XCConfig - import Kit.XCode.Prefix import Text.JSON import Kit.JSON import qualified Data.Traversable as T + -- Paths kitDir = "." "Kits" projectDir = "KitDeps.xcodeproj" prefixFile = "KitDeps_Prefix.pch" projectFile = projectDir "project.pbxproj" + xcodeConfigFile = "Kit.xcconfig" + prefixDefault = "#ifdef __OBJC__\n" ++ " #import \n #import \n" ++ "#endif\n" - - generateXCodeProject :: [FilePath] -> IO () - generateXCodeProject kitFileNames = do + + -- Represents an extracted project + -- Headers, Sources, Config, Prefix content + data KitContents = KitContents { contentHeaders :: [String], contentSources :: [String], contentConfig :: Maybe XCConfig, contentPrefix :: Maybe String } + + readKitContents :: Kit -> IO KitContents + readKitContents kit = + let kitDir = kitFileName kit + find tpe = glob ((kitDir "src/**/*") ++ tpe) + headers = find ".h" + sources = fmap join $ T.sequence [find ".m", find ".mm", find ".c"] + config = readConfig kit + prefix = readHeader kit + in KitContents <$> headers <*> sources <*> config <*> prefix + + generateXCodeProject :: [Kit] -> IO () + generateXCodeProject deps = do mkdir_p kitDir inDirectory kitDir $ do - let find tpe inDir = glob (inDir ++ "/src/**/*" ++ tpe) - let find' tpe = fmap join . T.for kitFileNames $ find tpe - headers <- find' ".h" - sources <- (\a b c -> a ++ b ++ c) <$> glob "**/src/**/*.m" <*> glob "**/src/**/*.mm" <*> glob "**/src/**/*.c" - mkdir_p projectDir - writeFile projectFile $ buildXCodeProject headers sources - combinedHeader <- generatePrefixHeader kitFileNames - writeFile prefixFile $ prefixDefault ++ combinedHeader ++ "\n" + kitsContents <- T.for deps readKitContents + createProjectFile kitsContents + createHeader kitsContents + createConfig kitsContents + where kitFileNames = deps |> kitFileName + createProjectFile cs = do + let headers = cs >>= contentHeaders + let sources = cs >>= contentSources + mkdir_p projectDir + writeFile projectFile $ buildXCodeProject headers sources + createHeader cs = do + let headers = catMaybes $ cs |> contentPrefix + let combinedHeader = stringJoin "\n" headers + writeFile prefixFile $ prefixDefault ++ combinedHeader ++ "\n" + createConfig cs = do + let configs = catMaybes $ cs |> contentConfig + let combinedConfig = multiConfig "KitConfig" configs + let kitHeaders = "HEADER_SEARCH_PATHS = $(HEADER_SEARCH_PATHS) " ++ (stringJoin " " $ kitFileNames >>= (\x -> [kitDir x "src", x "src"])) ++ "\n" ++ "GCC_PRECOMPILE_PREFIX_HEADER = YES\nGCC_PREFIX_HEADER = $(SRCROOT)/KitDeps_Prefix.pch\n" + writeFile xcodeConfigFile $ kitHeaders ++ "\n" ++ configToString combinedConfig + + kitPrefixFile = "Prefix.pch" - readConfig' :: Kit -> IO (Maybe XCConfig) - readConfig' kit = do + readHeader :: Kit -> IO (Maybe String) + readHeader kit = do + let fp = kitFileName kit kitPrefixFile exists <- doesFileExist fp contents <- T.sequence (fmap readFile $ justTrue exists fp) + return contents + + readConfig :: Kit -> IO (Maybe XCConfig) + readConfig kit = do + let fp = kitConfigFile kit + exists <- doesFileExist fp + contents <- T.sequence (fmap readFile $ justTrue exists fp) return $ fmap (fileContentsToXCC $ kitName kit) contents - where - fp = kitConfigFile kit - - generateXCodeConfig :: [FilePath] -> IO () - generateXCodeConfig kitFileNames = do - inDirectory kitDir $ unKitIO $ do - ca <- readMany kitFileNames "KitSpec" (\x -> readSpec x |> specKit >>= (liftIO . readConfig')) - let combinedConfig = multiConfig "KitConfig" ca - let contents = configToString combinedConfig - let xcconfig = "HEADER_SEARCH_PATHS = $(HEADER_SEARCH_PATHS) " ++ (stringJoin " " $ kitFileNames >>= (\x -> [kitDir x "src", x "src"])) ++ "\n" ++ "GCC_PRECOMPILE_PREFIX_HEADER = YES\nGCC_PREFIX_HEADER = $(SRCROOT)/KitDeps_Prefix.pch\n" - liftIO $ writeFile "Kit.xcconfig" $ xcconfig ++ "\n" ++ contents - return () depsForSpec :: KitRepository -> KitSpec -> KitIO [Kit] depsForSpec kr spec = do deps <- mapM (getDeps kr) (specDependencies spec) - return $ specDependencies spec ++ join deps + return . nub . sort $ specDependencies spec ++ join deps -- TODO Check for conflicting versions getDeps :: KitRepository -> Kit -> KitIO [Kit] getDeps kr kit = getKitSpec kr kit >>= depsForSpec kr diff --git a/Kit/Repository.hs b/Kit/Repository.hs --- a/Kit/Repository.hs +++ b/Kit/Repository.hs @@ -48,7 +48,7 @@ webRepo :: String -> KitRepository webRepo baseUrl = KitRepository save read where - save = download + save = download read = getBody fileRepo :: String -> KitRepository @@ -70,7 +70,7 @@ getBody path = let request = defaultGETRequest_ . fromJust . parseURI checkResponse r = justTrue (rspCode r == (2,0,0)) r - leftMaybe = either (const Nothing) Just + leftMaybe = either (const Nothing) Just in do rr <- Network.HTTP.simpleHTTP $ request path return $ fmap rspBody $ leftMaybe rr diff --git a/Kit/Util.hs b/Kit/Util.hs --- a/Kit/Util.hs +++ b/Kit/Util.hs @@ -18,7 +18,7 @@ import Data.Monoid import Control.Monad.Trans - (|>) ma f = fmap f ma + ma |> f = fmap f ma maybeRead :: Read a => String -> Maybe a maybeRead = fmap fst . listToMaybe . reads @@ -34,38 +34,43 @@ maybeToLeft :: b -> Maybe a -> Either a b maybeToLeft _ (Just a) = Left a maybeToLeft b Nothing = Right b - + instance Foldable (Either c) where foldr f z (Left c) = z foldr f z (Right a) = f a z - + instance T.Traversable (Either c) where sequenceA = either (pure . Left) (Right <$>) - + type KitError = String - + data KitIO a = KitIO { unKitIO :: (IO (Either [KitError] a)) } - + kitError :: KitError -> KitIO a kitError e = KitIO . return $ Left [e] - + maybeToKitIO msg = maybe (kitError msg) return - + instance Monad KitIO where (KitIO ioE) >>= f = KitIO $ ioE >>= g where g l@(Left v) = return (Left v) g (Right v) = unKitIO $ f v - + return = KitIO . return . Right - + instance Functor KitIO where fmap f kio = kio >>= (return . f) - + instance MonadIO KitIO where liftIO v = KitIO (fmap Right v) - - mLookup a as = maybe (fail $ "No such element: " ++ a) return (lookup a as) + instance Applicative KitIO where + pure = return + mf <*> ma = do + f <- mf + a <- ma + return $ f a + mkdir_p :: FilePath -> IO () mkdir_p = createDirectoryIfMissing True @@ -74,7 +79,7 @@ exists <- doesDirectoryExist directory when exists $ removeDirectoryRecursive directory mkdir_p directory - + inDirectory :: FilePath -> IO a -> IO a inDirectory dir actions = do cwd <- getCurrentDirectory @@ -85,14 +90,7 @@ glob :: String -> IO [String] glob pattern = fmap lines (readProcess "ruby" ["-e", "puts Dir.glob(\"" ++ pattern ++ "\")"] []) - + stringJoin :: Monoid a => a -> [a] -> a stringJoin x = mconcat . intersperse x - -- For each directory that exists, execute the function with the given filepath - readMany :: MonadIO m => [FilePath] -> FilePath -> (String -> m (Maybe a)) -> m [a] - readMany dirs fileInDir f = do - directories <- liftIO $ filterM doesDirectoryExist dirs - let kitSpecFiles = map ( fileInDir) directories - kitContents <- mapM f kitSpecFiles - return $ catMaybes kitContents diff --git a/Kit/XCode/Prefix.hs b/Kit/XCode/Prefix.hs deleted file mode 100644 --- a/Kit/XCode/Prefix.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Kit.XCode.Prefix where - - import Kit.Util - import qualified Data.Traversable as T - - kitPrefixFile = "Prefix.pch" - - generatePrefixHeader :: [FilePath] -> IO String - generatePrefixHeader kitFileNames = do - ca <- readMany kitFileNames kitPrefixFile $ \s -> do - exists <- doesFileExist s - T.for (justTrue exists s) readFile - return $ stringJoin "\n" ca diff --git a/kit.cabal b/kit.cabal --- a/kit.cabal +++ b/kit.cabal @@ -1,5 +1,5 @@ Name: kit -Version: 0.2 +Version: 0.3 Synopsis: A dependency manager for XCode (Objective-C) projects Description: A dependency manager for XCode (Objective-C) projects Category: Development @@ -11,6 +11,6 @@ Cabal-Version: >=1.2 Executable kit Main-is: Main.hs - Other-Modules: Kit.JSON, Kit.Kit, Kit.Main, Kit.Package, Kit.Project, Kit.Repository, Kit.Spec, Kit.Util, Kit.XCode.Builder, Kit.XCode.Common, Kit.XCode.Prefix, Kit.XCode.ProjectFile, Kit.XCode.XCConfig + Other-Modules: Kit.JSON, Kit.Kit, Kit.Main, Kit.Package, Kit.Project, Kit.Repository, Kit.Spec, Kit.Util, Kit.XCode.Builder, Kit.XCode.Common, Kit.XCode.ProjectFile, Kit.XCode.XCConfig Build-Depends: base >= 3 && < 5, HTTP >= 4000.0.9, network, bytestring, filepath, directory, process, json, mtl, cmdargs, MissingH, containers, QuickCheck