packages feed

kit 0.6.3 → 0.6.4

raw patch · 11 files changed

+119/−87 lines, 11 files

Files

Kit/CmdArgs.hs view
@@ -4,7 +4,7 @@   import System.Console.CmdArgs as CA    appVersion :: String-  appVersion = "0.6" -- TODO how to keep this up to date with kit.cabal?+  appVersion = "0.6.4" -- TODO how to keep this up to date with kit.cabal?    data KitCmdArgs = Update                   | Package
Kit/Commands.hs view
@@ -12,8 +12,8 @@ import Kit.Util import Kit.Spec import Kit.Repository-import Kit.Project +import qualified Data.ByteString as BS import System.Exit (exitFailure)  import Control.Monad.Error@@ -42,8 +42,15 @@         handleFails = either (\msg -> putStrLn ("kit error: " ++ msg) >> exitFailure) (const $ return ())  defaultLocalRepoPath :: IO FilePath-defaultLocalRepoPath = getHomeDirectory >>= \h -> return $ h </> ".kit" </> "repository"+defaultLocalRepoPath = (</> ".kit") <$> 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 
Kit/Contents.hs view
@@ -41,13 +41,13 @@ readHeader spec = do   let fp = packageFileName spec </> specPrefixFile spec   exists <- doesFileExist fp-  T.sequence (fmap readFile $ justTrue exists 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   exists <- doesFileExist fp-  contents <- T.sequence (fmap readFile $ justTrue exists fp)+  contents <- T.sequence (fmap readFile $ ifTrue exists fp)   return $ fmap (fileContentsToXCC $ packageName spec) contents 
Kit/Main.hs view
@@ -15,7 +15,7 @@               spec <- mySpec               deps <- liftKit $ totalSpecDependencies repo spec               puts $ "Dependencies: " ++ stringJoin ", " (map packageFileName deps)-              liftIO $ mapM_ (installKit repo) 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."
Kit/Package.hs view
@@ -1,5 +1,4 @@ module Kit.Package (package) where-   import Kit.Spec   import Kit.Util   import System.Cmd@@ -9,24 +8,18 @@    fileBelongsInPackage :: KitSpec -> FilePath -> Bool   fileBelongsInPackage config fp = let-    isCore = elem fp [specSourceDirectory config, specTestDirectory config, specLibDirectory config, "KitSpec"]-    isProject = any (`isSuffixOf` fp) ["xcodeproj", "xcconfig", ".pch"]+    isCore = elem fp [specResourcesDirectory config, specSourceDirectory config, specTestDirectory config, specLibDirectory config, "KitSpec"]+    isProject = any (`isSuffixOf` fp) ["xcodeproj", "xcconfig", ".pch"] -- TODO this could just check for the defined config and prefi header       in isCore || isProject    package :: KitSpec -> IO ()   package spec = do-      tempDir <- getTemporaryDirectory-      distDir <- (</> "dist") <$> getCurrentDirectory-      let kd = tempDir </> kitPath-      cleanOrCreate kd-      contents <- getDirectoryContents "."-      mapM_ (copyAllTo kd) (filter (fileBelongsInPackage spec) contents)+      contents <- filter (fileBelongsInPackage spec) <$> getDirectoryContents "."       mkdirP distDir-      inDirectory tempDir $ sh $ "tar czf " ++ (distDir </> (kitPath ++ ".tar.gz")) ++ " " ++ kitPath+      sh $ "tar -czf " ++ (distDir </> (kitPath ++ ".tar.gz")) ++ " -s ,^," ++ kitPath ++ "/, " ++ join (intersperse " " contents)       return ()     where+      distDir = "dist"       kitPath = packageFileName spec-      sh c = liftIO $ system (trace c c)-      copyAllTo kd c = sh $ "cp -r " ++ c ++ " " ++ kd ++ "/"-+      sh c = liftIO . system $ trace c c 
Kit/Project.hs view
@@ -1,9 +1,8 @@ {-# LANGUAGE TupleSections #-} module Kit.Project (   totalSpecDependencies,-  installKit,-  generateXcodeProject,-  readSpec+  unpackKit,+  generateXcodeProject   )     where @@ -11,6 +10,7 @@ import Kit.Contents import Kit.Repository import Kit.Util+import Kit.Util.FSAction import Kit.Xcode.Builder import Kit.Xcode.XCConfig @@ -21,8 +21,6 @@ import System.Cmd import System.Posix.Files -import qualified Data.ByteString as BS- -- Paths  kitDir, projectDir, prefixFile, projectFile, xcodeConfigFile, depsConfigFile, kitUpdateMakeFilePath :: FilePath@@ -46,37 +44,32 @@                 "    #import <UIKit/UIKit.h>\n" ++                  "#endif\n" -generateXcodeProject :: [Kit] -> Maybe String -> KitIO ()-generateXcodeProject deps depsOnlyConfig = do-  specs <- forM deps $ \kit -> readSpec (kitDir </> packageFileName kit </> "KitSpec")  +generateXcodeProject :: [KitSpec] -> Maybe String -> KitIO ()+generateXcodeProject specs depsOnlyConfig = do   liftIO $ inDirectory kitDir $ do-    kitsContents <- forM specs readKitContents-    createProjectFile kitsContents-    createHeader kitsContents-    createConfig kitsContents specs-    writeFile depsConfigFile $ "#include \"" ++ xcodeConfigFile ++ "\"\n" ++ fromMaybe "" depsOnlyConfig +    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-  where sourceDirs specs = specs >>= (\spec -> [-            kitDir </> packageFileName spec </> specSourceDirectory spec, -            packageFileName spec </> specSourceDirectory spec-          ])-        createProjectFile cs = do-          let headers = cs >>= contentHeaders-          let sources = cs >>= contentSources-          let libs = cs >>= contentLibs-          mkdirP projectDir-          writeFile projectFile $ renderXcodeProject headers sources libs "libKitDeps.a"+  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"         createHeader cs = do           let headers = mapMaybe namedPrefix cs           let combinedHeader = stringJoin "\n" headers-          writeFile prefixFile $ prefixDefault ++ combinedHeader ++ "\n"-        createConfig cs specs = do+          FileCreate prefixFile $ 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 specs)+          let kitHeaders = "HEADER_SEARCH_PATHS = $(HEADER_SEARCH_PATHS) " ++ stringJoin " " sourceDirs           let prefixHeaders = "GCC_PRECOMPILE_PREFIX_HEADER = YES\nGCC_PREFIX_HEADER = $(SRCROOT)/Prefix.pch\n"-          writeFile xcodeConfigFile $ kitHeaders ++ "\n" ++  prefixHeaders ++ "\n" ++ configToString combinedConfig ++ "\n"-          writeFile kitUpdateMakeFilePath kitUpdateMakeFile+          FileCreate xcodeConfigFile $ kitHeaders ++ "\n" ++  prefixHeaders ++ "\n" ++ configToString combinedConfig ++ "\n"  symlinkAll :: [KitSpec] -> IO () symlinkAll specs = do@@ -84,41 +77,34 @@   mapM_ symlinkResources specs  symlinkResources :: KitSpec -> IO ()-symlinkResources spec = let when' a b = a >>= flip when b in do +symlinkResources spec = do    let resourcesDir = packageFileName spec </> specResourcesDirectory spec   let linkName = "Resources" </> packageName spec-  when' (fileExist linkName) $ do-    removeLink linkName+  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  -- | 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 -totalSpecDependencies :: KitRepository -> KitSpec -> KitIO [Kit]+-- todo: check for conflicts+-- todo: check for version ranges :)+totalSpecDependencies :: KitRepository -> KitSpec -> KitIO [KitSpec] totalSpecDependencies kr spec = refineDeps <$> unfoldTreeM (unfoldDeps kr) spec-    -- todo: check for conflicts-    -- todo: check for version ranges :) -unfoldDeps :: KitRepository -> KitSpec -> KitIO (Kit, [KitSpec])-unfoldDeps kr ks = (specKit ks,) <$> mapM (readKitSpec kr) (specDependencies ks) -- s/mapM/traverse ?+unfoldDeps :: KitRepository -> KitSpec -> KitIO (KitSpec, [KitSpec])+unfoldDeps kr ks = (ks,) <$> mapM (readKitSpec kr) (specDependencies ks) -- s/mapM/traverse ? -installKit :: KitRepository -> Kit -> IO ()-installKit kr kit = do+unpackKit :: KitRepository -> Kit -> IO ()+unpackKit kr kit = do     tmpDir <- getTemporaryDirectory     let fp = tmpDir </> (packageFileName kit ++ ".tar.gz")     putStrLn $ " -> Installing " ++ packageFileName kit-    extractKit kr kit fp+    copyKitPackage kr kit fp     mkdirP kitDir      inDirectory kitDir $ system ("tar zxf " ++ fp)     return ()--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 
Kit/Repository.hs view
@@ -1,22 +1,35 @@+{-# LANGUAGE PackageImports #-} module Kit.Repository (-    extractKit,-    readKitSpec,-    KitRepository(KitRepository)+    --+    KitRepository(KitRepository),+    --+    copyKitPackage,+    explodePackage,+    readKitSpec   ) where    import Kit.Spec   import Kit.Util -  import Control.Monad.Error-  import qualified Data.List as L+  import System.Process (system)++  import "mtl" Control.Monad.Error   import qualified Data.Traversable as T   import qualified Data.ByteString as BS    data KitRepository = KitRepository { repositoryBase :: FilePath } deriving (Eq, Show) -  extractKit :: KitRepository -> Kit -> FilePath -> IO ()-  extractKit repo kit destPath = copyFile (repositoryBase repo </> kitPackagePath kit) destPath+  explodePackage :: KitRepository -> Kit -> IO ()+  explodePackage kr kit = do+    let packagesDir = repositoryBase kr </> "kits"+    let packagePath = repositoryBase 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+   readKitSpec :: KitRepository -> Kit -> KitIO KitSpec   readKitSpec repo kit = do     mbKitStuff <- liftIO $ doRead repo (kitSpecPath kit)@@ -26,11 +39,10 @@   doRead :: KitRepository -> String -> IO (Maybe BS.ByteString)    doRead (KitRepository baseDir) fp = let file = (baseDir </> fp) in do     exists <- doesFileExist file-    T.sequenceA $ justTrue exists $ BS.readFile file+    T.sequenceA $ ifTrue exists $ BS.readFile file    baseKitPath :: Kit -> String-  baseKitPath k = joinS ["kits", kitName k, kitVersion k] "/"-    where joinS xs x = foldl1 (++) $ L.intersperse x xs+  baseKitPath k = stringJoin "/" ["kits", kitName k, kitVersion k]     kitPackagePath, kitSpecPath :: Kit -> String   kitPackagePath k = baseKitPath k ++ "/" ++ packageFileName k ++ ".tar.gz"
Kit/Spec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE PackageImports #-} module Kit.Spec (   -- | The Core Kit types   KitSpec(..),@@ -15,7 +16,7 @@   ) where    import Control.Applicative-  import Control.Monad.Trans+  import "mtl" Control.Monad.Trans     import Data.Object   import Kit.Util.IsObject@@ -32,7 +33,7 @@     specPrefixFile :: FilePath,     specConfigFile :: FilePath,     specKitDepsXcodeFlags :: Maybe String-  } deriving (Show, Read)+  } deriving (Show, Read, Eq)    updateVersion :: KitSpec -> (String -> String) -> KitSpec   updateVersion spec f = spec { specKit = (specKit spec) { kitVersion = f . kitVersion . specKit $ spec } } @@ -75,13 +76,16 @@    instance IsObject Kit where     showObject kit = Mapping [("name", w kitName), ("version", w kitVersion)] where w f = showObject . f $ kit-    readObject x = fromMapping x >>= \obj -> Kit <$> obj #> "name" <*> obj #> "version" +    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     showObject spec = Mapping [          "name" ~> (val $ kitName . specKit),          "version" ~> (val $ kitVersion . specKit),-         "dependencies" ~> showObject (specDependencies spec)+         "dependencies" ~> showObject (specDependencies spec),+         "source-directory" ~> val specSourceDirectory        ] where a ~> b = (a, b)               val f = Scalar . f $ spec 
Kit/Util.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TypeSynonymInstances, PackageImports #-}  module Kit.Util(   module Kit.Util,@@ -17,24 +17,27 @@    import Control.Applicative   import Control.Monad-  import Control.Monad.Error+  import "mtl" Control.Monad.Error -  import qualified Control.Monad.State as S+  import qualified "mtl" Control.Monad.State as S    popS :: S.State [a] a   popS = do     (x:t) <- S.get     S.put t     return x-  ++  when' :: Monad m => m Bool -> m () -> m ()+  when' a b = a >>= flip when b+   puts :: MonadIO m => String -> m ()   puts a = liftIO $ putStrLn a    maybeRead :: Read a => String -> Maybe a   maybeRead = fmap fst . listToMaybe . reads -  justTrue :: Bool -> a -> Maybe a-  justTrue p a = if p then Just a else Nothing+  ifTrue :: MonadPlus m => Bool -> a -> m a+  ifTrue p a = if p then return a else mzero    maybeToRight :: b -> Maybe a -> Either b a   maybeToRight v = maybe (Left v) Right
+ Kit/Util/FSAction.hs view
@@ -0,0 +1,27 @@+module Kit.Util.FSAction where++import System.FilePath+import System.Posix.Files++import Kit.Util++data FSAction = +    FileCreate FilePath String+  | Symlink FilePath FilePath+  | InDir FilePath FSAction+  deriving (Eq, Show)++within :: FilePath -> FSAction -> FSAction+within = InDir++runAction :: FSAction -> IO ()+runAction (FileCreate atPath contents) = do+  mkdirP $ dropFileName atPath +  writeFile atPath contents+runAction (Symlink target name) = do+  when' (fileExist name) $ removeLink name +  createSymbolicLink target name+runAction (InDir dir action) = do+  mkdirP dir+  inDirectory dir $ runAction action+
kit.cabal view
@@ -1,5 +1,5 @@ name:           kit-version:        0.6.3+version:        0.6.4 cabal-version:  >=1.2 build-type:     Simple license:        BSD3@@ -23,5 +23,5 @@   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.Contents Kit.Commands Kit.CmdArgs Kit.Util.IsObject Kit.Util.FSAction   Ghc-options:    -Wall -fno-warn-unused-do-bind