kit 0.4 → 0.4.1
raw patch · 13 files changed
+156/−148 lines, 13 files
Files
- Kit/JSON.hs +0/−35
- Kit/Kit.hs +0/−15
- Kit/Main.hs +1/−2
- Kit/Model.hs +63/−0
- Kit/Package.hs +7/−8
- Kit/Project.hs +5/−14
- Kit/Repository.hs +18/−20
- Kit/Spec.hs +0/−18
- Kit/Util.hs +18/−17
- Kit/XCode/PBXProject.hs +33/−4
- Kit/XCode/ProjectFile.hs +2/−2
- Main.hs +0/−4
- kit.cabal +9/−9
− Kit/JSON.hs
@@ -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)-
− Kit/Kit.hs
@@ -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")
Kit/Main.hs view
@@ -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
+ Kit/Model.hs view
@@ -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)+
Kit/Package.hs view
@@ -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 ++ "/"- - ++
Kit/Project.hs view
@@ -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])
Kit/Repository.hs view
@@ -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+++
− Kit/Spec.hs
@@ -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"
Kit/Util.hs view
@@ -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- ++
Kit/XCode/PBXProject.hs view
@@ -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
Kit/XCode/ProjectFile.hs view
@@ -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`
Main.hs view
@@ -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
kit.cabal view
@@ -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: