diff --git a/Kit/JSON.hs b/Kit/JSON.hs deleted file mode 100644 --- a/Kit/JSON.hs +++ /dev/null @@ -1,35 +0,0 @@ -module Kit.JSON where - import Kit.Kit - import Kit.Spec - import Kit.Util - import Control.Applicative - import Text.JSON - - instance JSON Kit where - showJSON kit = makeObj - [ ("name", showJSON $ kitName kit) - , ("version", showJSON $ kitVersion kit) - ] - - readJSON (JSObject obj) = Kit <$> f "name" <*> f "version" - where f x = mLookup x jsonObjAssoc >>= readJSON - jsonObjAssoc = fromJSObject obj - - instance JSON KitSpec where - showJSON spec = makeObj - [ ("name", showJSON $ kitName kit) - , ("version", showJSON $ kitVersion kit) - , ("dependencies", showJSON $ specDependencies spec) - ] - where kit = specKit spec - - readJSON (JSObject obj) = - let myKit = Kit <$> f "name" <*> f "version" - myConfig = (KitConfiguration <$> f "dependencies" <*> (f "sourceDir" <|> pure "src")) - 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 deleted file mode 100644 --- a/Kit/Kit.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Kit.Kit where - import Kit.Util - - type Version = String - - data Kit = Kit { - kitName :: String, - kitVersion :: Version - } deriving (Eq, Show, Ord, Read) - - kitFileName :: Kit -> String - kitFileName k = kitName k ++ "-" ++ kitVersion k - - kitConfigFile :: Kit -> String - kitConfigFile kit = kitFileName kit (kitName kit ++ ".xcconfig") diff --git a/Kit/Main.hs b/Kit/Main.hs --- a/Kit/Main.hs +++ b/Kit/Main.hs @@ -6,11 +6,10 @@ import Data.List import Data.Maybe import Data.Monoid - import Kit.Kit + import Kit.Model import Kit.Package import Kit.Project import Kit.Repository - import Kit.Spec import Kit.Util import Kit.XCode.Builder import qualified Data.Traversable as T diff --git a/Kit/Model.hs b/Kit/Model.hs new file mode 100644 --- /dev/null +++ b/Kit/Model.hs @@ -0,0 +1,63 @@ +module Kit.Model where + + import Text.JSON + import Control.Applicative + import System.FilePath.Posix + + data KitSpec = KitSpec { + specKit :: Kit, + specConfiguration :: KitConfiguration + } deriving (Show, Read) + + data KitConfiguration = KitConfiguration { + kitConfigDependencies :: [Kit], + sourceDir :: FilePath + } deriving (Show, Read) + + specDependencies :: KitSpec -> [Kit] + specDependencies = kitConfigDependencies . specConfiguration + + defaultConfiguration :: KitConfiguration + defaultConfiguration = KitConfiguration [] "src" + + type Version = String + + data Kit = Kit { + kitName :: String, + kitVersion :: Version + } deriving (Eq, Show, Ord, Read) + + kitFileName :: Kit -> String + kitFileName k = kitName k ++ "-" ++ kitVersion k + + kitConfigFile :: Kit -> String + kitConfigFile kit = kitFileName kit (kitName kit ++ ".xcconfig") + + instance JSON Kit where + showJSON kit = makeObj + [ ("name", showJSON $ kitName kit) + , ("version", showJSON $ kitVersion kit) + ] + + readJSON (JSObject obj) = Kit <$> f "name" <*> f "version" + where f x = mLookup x jsonObjAssoc >>= readJSON + jsonObjAssoc = fromJSObject obj + + instance JSON KitSpec where + showJSON spec = makeObj + [ ("name", showJSON $ kitName kit) + , ("version", showJSON $ kitVersion kit) + , ("dependencies", showJSON $ specDependencies spec) + ] + where kit = specKit spec + + readJSON (JSObject obj) = + let myKit = Kit <$> f "name" <*> f "version" + myConfig = (KitConfiguration <$> f "dependencies" <*> (f "sourceDir" <|> pure "src")) + 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/Package.hs b/Kit/Package.hs --- a/Kit/Package.hs +++ b/Kit/Package.hs @@ -1,16 +1,15 @@ module Kit.Package (package) where - import Kit.Kit - import Kit.Spec + import Kit.Model import Kit.Util import Kit.Project import System.Cmd import Control.Monad.Trans import Control.Monad import Data.List - import Data.Maybe + import Data.Maybe import Debug.Trace - + {- Package format src/ | configurable source dir @@ -18,7 +17,7 @@ KitSpec *.codeproj -} - + fileBelongsInPackage :: KitConfiguration -> FilePath -> Bool fileBelongsInPackage config fp = let a = elem fp [sourceDir config, "test", "KitSpec"] @@ -26,7 +25,7 @@ c = "xcconfig" `isSuffixOf` fp d = ".pch" `isSuffixOf` fp in a || b || c || d - + package :: KitSpec -> IO () package spec = do tempDir <- getTemporaryDirectory @@ -43,5 +42,5 @@ puts c = liftIO $ putStrLn c p c = liftIO $ print c cp_r_to kd c = sh $ "cp -r " ++ c ++ " " ++ kd ++ "/" - - + + diff --git a/Kit/Project.hs b/Kit/Project.hs --- a/Kit/Project.hs +++ b/Kit/Project.hs @@ -14,14 +14,12 @@ import Data.Tree import Data.Monoid import System.Cmd - import Kit.Kit + import Kit.Model import Kit.Repository import Kit.Util - import Kit.Spec import Kit.XCode.Builder import Kit.XCode.XCConfig import Text.JSON - import Kit.JSON import qualified Data.Traversable as T -- Paths @@ -55,18 +53,18 @@ createProjectFile kitsContents createHeader kitsContents createConfig kitsContents - where kitFileNames = deps |> kitFileName + where kitFileNames = map kitFileName deps 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 headers = mapMaybe contentPrefix cs let combinedHeader = stringJoin "\n" headers writeFile prefixFile $ prefixDefault ++ combinedHeader ++ "\n" createConfig cs = do - let configs = catMaybes $ cs |> contentConfig + let configs = mapMaybe contentConfig cs 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 @@ -87,20 +85,13 @@ contents <- T.sequence (fmap readFile $ justTrue exists fp) return $ fmap (fileContentsToXCC $ kitName kit) contents - depsForSpec :: KitRepository -> KitSpec -> KitIO [Kit] - depsForSpec kr spec = do - deps <- mapM (getDeps kr) (specDependencies spec) - return . nub . sort $ specDependencies spec ++ join deps -- TODO Check for conflicting versions - where getDeps kr kit = getKitSpec kr kit >>= depsForSpec kr - - refineDeps :: Tree Kit -> [Kit] refineDeps = nub . concat . reverse . drop 1 . levels depsForSpec' :: KitRepository -> KitSpec -> KitIO [Kit] depsForSpec' kr spec = do tree <- unfoldTreeM (unfoldDeps kr) spec - -- todo: check for dups, check for conflicts + -- todo: check for conflicts return $ refineDeps tree unfoldDeps :: KitRepository -> KitSpec -> KitIO (Kit, [KitSpec]) diff --git a/Kit/Repository.hs b/Kit/Repository.hs --- a/Kit/Repository.hs +++ b/Kit/Repository.hs @@ -13,31 +13,29 @@ fileRepo, KitRepository ) where - - import Kit.Spec - import Kit.Kit + + import Kit.Model import Kit.Util - import Data.List + import Network.HTTP import Network.URI import Network.BufferType + import qualified Data.List as L import Data.Maybe - import Data.Traversable + import qualified Data.Traversable as T import Control.Monad import Control.Monad.Trans - import Debug.Trace import Text.JSON - import Kit.JSON import qualified Data.ByteString as BS data KitRepository = KitRepository { repoSave :: String -> FilePath -> IO (Maybe ()), repoRead :: String -> IO (Maybe String) } - + getKit :: KitRepository -> Kit -> FilePath -> IO (Maybe ()) getKit kr k = repoSave kr (kitPackagePath k) - + getKitSpec :: KitRepository -> Kit -> KitIO KitSpec getKitSpec kr k = do mbKitStuff <- liftIO $ repoRead kr (kitSpecPath k) @@ -45,7 +43,7 @@ where f contents = maybeToKitIO ("Invalid KitSpec file for " ++ kitFileName k) $ case (decode contents) of Ok a -> Just a Error _ -> Nothing - + webRepo :: String -> KitRepository webRepo baseUrl = KitRepository save read where save = download @@ -56,16 +54,16 @@ save src destPath = Just <$> copyFile (baseDir src) destPath read path = let file = (baseDir path) in do exists <- doesFileExist file - sequenceA $ justTrue exists $ readFile file - + T.sequenceA $ justTrue exists $ readFile file + -- private! baseKitPath :: Kit -> String baseKitPath k = joinS ["kits", kitName k, kitVersion k] "/" - where joinS xs x = foldl1 (++) $ intersperse x xs - + where joinS xs x = foldl1 (++) $ L.intersperse x xs + kitPackagePath k = baseKitPath k ++ "/" ++ kitFileName k ++ ".tar.gz" kitSpecPath k = baseKitPath k ++ "/" ++ "KitSpec" - + getBody :: BufferType a => HStream a => String -> IO (Maybe a) getBody path = let request = defaultGETRequest_ . fromJust . parseURI @@ -74,11 +72,11 @@ in do rr <- Network.HTTP.simpleHTTP $ request path return $ fmap rspBody $ leftMaybe rr - + download :: String -> FilePath -> IO (Maybe ()) download url destination = do body <- getBody url - sequenceA $ fmap (BS.writeFile destination) body - - - + T.sequenceA $ fmap (BS.writeFile destination) body + + + diff --git a/Kit/Spec.hs b/Kit/Spec.hs deleted file mode 100644 --- a/Kit/Spec.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Kit.Spec where - import Kit.Kit - - data KitSpec = KitSpec { - specKit :: Kit, - specConfiguration :: KitConfiguration - } deriving (Show, Read) - - data KitConfiguration = KitConfiguration { - kitConfigDependencies :: [Kit], - sourceDir :: FilePath - } deriving (Show, Read) - - specDependencies :: KitSpec -> [Kit] - specDependencies = kitConfigDependencies . specConfiguration - - defaultConfiguration :: KitConfiguration - defaultConfiguration = KitConfiguration [] "src" diff --git a/Kit/Util.hs b/Kit/Util.hs --- a/Kit/Util.hs +++ b/Kit/Util.hs @@ -1,8 +1,8 @@ {-# LANGUAGE TypeSynonymInstances #-} module Kit.Util( - module Kit.Util, - module Control.Applicative, + module Kit.Util, + module Control.Applicative, module System.FilePath.Posix, module System.Directory ) where @@ -17,20 +17,20 @@ import Control.Monad 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 - + justTrue :: Bool -> a -> Maybe a justTrue True a = Just a justTrue False _ = Nothing - + maybeToRight :: b -> Maybe a -> Either b a maybeToRight _ (Just a) = Right a maybeToRight b Nothing = Left b - + maybeToLeft :: b -> Maybe a -> Either a b maybeToLeft _ (Just a) = Left a maybeToLeft b Nothing = Right b @@ -56,30 +56,30 @@ where g l@(Left v) = return (Left v) g (Right v) = unKitIO $ f v - return = KitIO . return . Right + return = KitIO . return . Right instance Functor KitIO where fmap f kio = kio >>= (return . f) - + instance MonadIO KitIO where liftIO v = KitIO (fmap Right v) - + instance Applicative KitIO where pure = return mf <*> ma = do f <- mf a <- ma return $ f a - + mkdir_p :: FilePath -> IO () mkdir_p = createDirectoryIfMissing True - + cleanOrCreate :: FilePath -> IO () cleanOrCreate directory = do exists <- doesDirectoryExist directory when exists $ removeDirectoryRecursive directory mkdir_p directory - + inDirectory :: FilePath -> IO a -> IO a inDirectory dir actions = do cwd <- getCurrentDirectory @@ -87,10 +87,11 @@ v <- actions setCurrentDirectory cwd return v - + 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 - + + diff --git a/Kit/XCode/PBXProject.hs b/Kit/XCode/PBXProject.hs --- a/Kit/XCode/PBXProject.hs +++ b/Kit/XCode/PBXProject.hs @@ -4,27 +4,53 @@ import Kit.XCode.OldPList import Control.Monad.State import Control.Monad.Writer +import qualified Data.Map as M type UUID = String +data UUIDValue = UUIDProject PBXProject | UUIDGroup PBXGroup deriving (Eq, Show, Ord) + +data UUIDState = UUIDState { + unusedUUIDs :: [UUID] + , knownObjects :: M.Map UUIDValue UUID +} + +lookupObject :: UUIDValue -> State UUIDState UUID --UUIDState -> (UUIDState, UUIValue) +lookupObject v = do + s <- get + let o = M.lookup v $ knownObjects s + maybe (insertObject v) return o + where insertObject v = do + s@(UUIDState (u:uuids) objects) <- get + put $ UUIDState uuids (M.insert v u objects) + return u + data PBXProject = PBXProject { projectConfigurationList :: XCConfigurationList , projectGroups :: [PBXGroup] , projectName :: String -} + , targets :: [PBXNativeTarget] +} deriving (Eq, Show, Ord) +data PBXNativeTarget = PBXNativeTarget { + targetConfigurationList :: XCConfigurationList + , targetBuildPhases :: [PBXBuildPhase] +} deriving (Eq, Show, Ord) + +data PBXBuildPhase = PBXBuildPhase deriving (Eq, Show, Ord) + data XCConfigurationList = XCConfigurationList { configurationsList :: [XCBuildConfiguration] -} +} deriving (Eq, Show, Ord) data PBXGroup = PBXGroup { groupChildren :: [PBXGroup] , groupChildrenExtra :: [UUID] , groupName :: String , groupSourceTree :: String -} +} deriving (Eq, Show, Ord) -data XCBuildConfiguration = XCBuildConfiguration +data XCBuildConfiguration = XCBuildConfiguration deriving (Eq, Show, Ord) instance ProjectPListItem PBXGroup where writeEntry group = do @@ -53,6 +79,9 @@ uuid <- popS tell [(uuid, blah)] return uuid + +f :: M.Map UUID a -> a -> (M.Map UUID a, UUID) +f = undefined instance ProjectPListItem PBXProject where writeEntry project = do diff --git a/Kit/XCode/ProjectFile.hs b/Kit/XCode/ProjectFile.hs --- a/Kit/XCode/ProjectFile.hs +++ b/Kit/XCode/ProjectFile.hs @@ -147,7 +147,7 @@ "GCC_WARN_UNUSED_VARIABLE = YES;" `nl` "OTHER_LDFLAGS = \"-ObjC\";" `nl` "PREBINDING = NO;" `nl` - "SDKROOT = iphoneos4.0;" `nl` + "SDKROOT = iphoneos4.1;" `nl` "};" `nl` "name = Debug;" `nl` "};" `nl` @@ -161,7 +161,7 @@ "GCC_WARN_UNUSED_VARIABLE = YES;" `nl` "OTHER_LDFLAGS = \"-ObjC\";" `nl` "PREBINDING = NO;" `nl` - "SDKROOT = iphoneos4.0;" `nl` + "SDKROOT = iphoneos4.1;" `nl` "};" `nl` "name = Release;" `nl` "};" `nl` diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -5,8 +5,4 @@ import Kit.XCode.OldPList import Kit.XCode.PBXProject - conf1 = XCC "conf1" (M.fromList [("A", "1")]) [] - conf2 = XCC "conf2" (M.fromList [("A", "2")]) [] - - --main = putStrLn $ show $ multiConfig "combo" [conf1, conf2] main = kitMain diff --git a/kit.cabal b/kit.cabal --- a/kit.cabal +++ b/kit.cabal @@ -1,15 +1,15 @@ name: kit -version: 0.4 +version: 0.4.1 cabal-version: >=1.2 build-type: Simple license: BSD3 license-file: LICENSE copyright: maintainer: nkpart@gmail.com -build-depends: HTTP >=4000.0.9, MissingH -any, QuickCheck -any, - base >=3 && <5, bytestring -any, cmdargs >=0.3, containers -any, - directory -any, filepath -any, json -any, mtl -any, network -any, - process -any +build-depends: process -any, network -any, mtl -any, json -any, + filepath -any, directory -any, containers -any, cmdargs >=0.3, + bytestring -any, base >=3 && <5, QuickCheck -any, MissingH -any, + HTTP >=4000.0.9 stability: homepage: package-url: @@ -41,10 +41,10 @@ install-includes: include-dirs: hs-source-dirs: . -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.OldPList Kit.XCode.PBXProject Kit.XCode.ProjectFile - Kit.XCode.XCConfig +other-modules: Kit.Model Kit.Main Kit.Package + Kit.Project Kit.Repository Kit.Util Kit.XCode.Builder + Kit.XCode.Common Kit.XCode.OldPList Kit.XCode.PBXProject + Kit.XCode.ProjectFile Kit.XCode.XCConfig ghc-prof-options: ghc-shared-options: ghc-options: