packages feed

kit 0.6.8 → 0.7.0

raw patch · 12 files changed

+305/−178 lines, 12 files

Files

Kit/CmdArgs.hs view
@@ -4,7 +4,7 @@   import System.Console.CmdArgs as CA    appVersion :: String-  appVersion = "0.6.7" -- TODO how to keep this up to date with kit.cabal?+  appVersion = "0.7.0" -- TODO how to keep this up to date with kit.cabal?    data KitCmdArgs = Update                   | Package
Kit/Commands.hs view
@@ -3,24 +3,23 @@   Command,   liftKit,   mySpec,-  mySpecFile,+  myWorkingCopy,   myRepository,   runCommand,-  defaultLocalRepoPath,   defaultLocalRepository ) where  import Kit.Util import Kit.Spec import Kit.Repository+import Kit.WorkingCopy -import qualified Data.ByteString as BS import System.Exit (exitFailure)  import Control.Monad.Error import Control.Monad.Reader -newtype Command a = Command (ReaderT (KitSpec, KitRepository) (ErrorT String IO) a) deriving Monad+newtype Command a = Command (ReaderT (WorkingCopy, KitRepository) (ErrorT String IO) a) deriving (Monad, Functor, Applicative)  instance MonadIO Command where   liftIO a = Command $ liftIO a@@ -29,32 +28,22 @@ liftKit = Command . ReaderT . const  mySpec :: Command KitSpec-mySpec = Command $ fmap fst ask+mySpec = fmap workingKitSpec myWorkingCopy +myWorkingCopy :: Command WorkingCopy+myWorkingCopy = Command $ fmap fst ask+ myRepository :: Command KitRepository myRepository = Command $ fmap snd ask -mySpecFile :: Command FilePath-mySpecFile = return "KitSpec"- runCommand :: Command a -> IO () runCommand (Command cmd) = run $ do-  spec <- readSpec "KitSpec"+  spec <- currentWorkingCopy   repository <- liftIO defaultLocalRepository   runReaderT cmd (spec, repository)   where run = (handleFails =<<) . runErrorT         handleFails = either (\msg -> putStrLn ("kit error: " ++ msg) >> exitFailure) (const $ return ()) -defaultLocalRepoPath :: IO FilePath-defaultLocalRepoPath = (</> ".kit" </> "repository") <$> 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+defaultLocalRepository = makeRepository =<< (</> ".kit" ) <$> getHomeDirectory
Kit/Contents.hs view
@@ -1,63 +1,63 @@+{-# LANGUAGE PackageImports #-} module Kit.Contents (   KitContents(..),-  readKitContents,-  namedPrefix,-  makeContentsRelative +  readKitContents',+  namedPrefix   ) where  import Kit.Spec import Kit.Util import Kit.Xcode.XCConfig+import "mtl" Control.Monad.Trans  import qualified Data.Traversable as T  -- | The determined contents of a particular Kit data KitContents = KitContents { -  contentKit :: Kit,+  contentSpec :: KitSpec,   contentHeaders :: [FilePath],     -- ^ Paths to headers   contentSources :: [FilePath],     -- ^ Paths to source files   contentLibs :: [FilePath],        -- ^ Paths to static libs   contentConfig :: Maybe XCConfig,  -- ^ Contents of the xcconfig base file-  contentPrefix :: Maybe String     -- ^ Contents of the prefix header+  contentPrefix :: Maybe String,     -- ^ Contents of the prefix header+  contentResourceDir :: Maybe FilePath } -makeContentsRelative :: FilePath -> KitContents -> KitContents-makeContentsRelative base kc = let f p = map (makeRelative base) (p kc)-                                in kc { contentHeaders = f contentHeaders,-                                        contentSources = f contentSources,-                                        contentLibs = f contentLibs-                                      } - namedPrefix :: KitContents -> Maybe String-namedPrefix kc = fmap (\s -> "//" ++ (packageFileName . contentKit $ kc) ++ "\n" ++ s) $ contentPrefix kc+namedPrefix kc = fmap (\s -> "//" ++ (packageFileName . contentSpec $ kc) ++ "\n" ++ s) $ contentPrefix kc --- | Determine the contents for a Kit, assumes that we're in a --- folder containing exploded kits-readKitContents :: KitSpec -> IO KitContents-readKitContents spec  =-  let kitDir = packageFileName spec-      find dir tpe = do+readKitContents' :: (Applicative m, MonadIO m) => FilePath -> (KitSpec -> FilePath) -> KitSpec -> m KitContents+readKitContents' base f spec =+  let kitDir = f spec+      find dir tpe = liftIO $ inDirectory base $ do         files <- glob ((kitDir </> dir </> "**/*") ++ tpe)         mapM canonicalizePath files       findSrc = find $ specSourceDirectory spec       headers = findSrc ".h"-      sources = join <$> mapM findSrc [".m", ".mm", ".c"]+      sources = findSrc .=<<. [".m", ".mm", ".c"]       libs = find (specLibDirectory spec) ".a" -      config = readConfig spec-      prefix = readHeader spec-  in  KitContents (specKit spec) <$> headers <*> sources <*> libs <*> config <*> prefix+      config = liftIO $ readConfig (base </> kitDir) spec+      prefix = liftIO $ readHeader (base </> kitDir) spec+      resourceDir = liftIO $ do+        let r = base </> kitDir </> specResourcesDirectory spec+        b <- doesDirectoryExist r+        if b then+                Just <$> canonicalizePath r+             else+                return Nothing+  in  KitContents spec <$> headers <*> sources <*> libs <*> config <*> prefix <*> resourceDir  -- TODO report missing file-readHeader :: KitSpec -> IO (Maybe String)-readHeader spec = do-  let fp = packageFileName spec </> specPrefixFile spec+readHeader :: FilePath -> KitSpec -> IO (Maybe String)+readHeader kitDir spec = do+  let fp = kitDir </> specPrefixFile spec   exists <- doesFileExist 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+readConfig :: FilePath -> KitSpec -> IO (Maybe XCConfig)+readConfig kitDir spec = do+  let fp = kitDir </> specConfigFile spec   exists <- doesFileExist fp   contents <- T.sequence (fmap readFile $ ifTrue exists fp)   return $ fmap (fileContentsToXCC $ packageName spec) contents
+ Kit/Dependency.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TupleSections #-}+module Kit.Dependency (+    totalSpecDependencies,+    Dependency(..),+    depSpec,+    isDevDep,+    dependencyTree,+    devKitDir -- TODO, cleanup main, might not need to export+  ) where++import Kit.Util+import Kit.Spec+import Kit.Repository+import Kit.WorkingCopy+import Data.Tree+import Data.List++data Dependency = Dep KitSpec | Dev KitSpec FilePath deriving (Eq, Show)++depSpec (Dep k) = k+depSpec (Dev k _) = k+  +isDevDep :: Dependency -> Bool+isDevDep (Dep _) = False+isDevDep (Dev _ _) = True++-- | 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++-- todo: check for conflicts+-- todo: check for version ranges :)+totalSpecDependencies :: KitRepository -> WorkingCopy -> KitIO [Dependency]+totalSpecDependencies repo workingCopy = refineDeps <$> dependencyTree repo workingCopy++dependencyTree :: KitRepository -> WorkingCopy -> KitIO (Tree Dependency)+dependencyTree repo workingCopy = unfoldTreeM (unfoldDeps repo) (workingKitSpec workingCopy)++unfoldDeps :: KitRepository -> KitSpec -> KitIO (Dependency, [KitSpec])+unfoldDeps kr ks = (Dep ks,) <$> mapM (readKitSpec kr) (specDependencies ks) +
Kit/Main.hs view
@@ -7,37 +7,44 @@   import Kit.Package   import Kit.Project   import Kit.Util+  import Kit.Contents+  import Kit.Dependency+  import Kit.WorkingCopy   import System.Cmd   import System.Exit   import Data.Tree (drawTree)+  import Data.List (partition)+  import Kit.Repository (unpackKit, packagesDirectory, publishLocally) -  import System.Console.ANSI-  -  say :: MonadIO m => Color -> String -> m ()-  say color msg = do-    liftIO $ setSGR [SetColor Foreground Vivid color]-    puts msg-    liftIO $ setSGR []+  f2 spec = do +          base <- liftIO $ canonicalizePath devKitDir+          readKitContents' base packageName spec -  alert :: MonadIO m => String -> m ()-  alert = say Red+  f1 packagesDirectory spec = do+          base <- liftIO $ canonicalizePath packagesDirectory+          readKitContents' base packageFileName spec     doUpdate :: Command ()   doUpdate = do               repo <- myRepository-              spec <- mySpec-              deps <- liftKit $ totalSpecDependencies repo spec-              liftIO $ mapM_ (unpackKit repo . specKit) deps+              workingCopy <- myWorkingCopy+              let spec = workingKitSpec workingCopy+              deps <- liftKit $ totalSpecDependencies repo workingCopy+              let (devPackages, notDevPackages) = partition isDevDep deps+              liftIO $ mapM_ ((unpackKit repo . specKit) . depSpec) notDevPackages+              liftIO $ mapM_ (\s -> say Red $ " -> Using dev package: " ++ packageName (depSpec s)) devPackages               puts " -> Generating Xcode project..."-              liftKit $ generateKitProjectFromSpecs deps (specKitDepsXcodeFlags spec)+              devSpecs <- mapM (f2 . depSpec) devPackages+              notDevSpecs <- mapM (f1 (packagesDirectory repo) . depSpec) notDevPackages+              liftKit $ writeKitProjectFromContents (devSpecs ++ notDevSpecs) (specKitDepsXcodeFlags spec) (packagesDirectory repo)               say Green "\n\tKit complete. You may need to restart Xcode for it to pick up any changes.\n"    doShowTree :: Command ()   doShowTree = do     repo <- myRepository-    spec <- mySpec-    tree <- liftKit $ dependencyTree repo spec-    liftIO $ putStrLn $ drawTree $ fmap packageFileName $ tree+    wc <- myWorkingCopy+    tree <- liftKit $ dependencyTree repo wc+    liftIO $ putStrLn $ drawTree $ fmap (packageFileName . depSpec) tree    doPackageKit :: Command ()   doPackageKit = mySpec >>= liftIO . package @@ -45,21 +52,13 @@   doPublishLocal :: Maybe String -> Command ()   doPublishLocal versionTag = do     spec <- mySpec -    specFile <- mySpecFile+    specFile <- workingSpecFile <$> myWorkingCopy+    repo <- myRepository     let updatedSpec = maybe spec (\tag -> updateVersion spec (++tag)) versionTag     liftIO $ do       package updatedSpec -      publishLocal updatedSpec specFile+      publishLocally repo updatedSpec specFile $ "dist" </> packageFileName updatedSpec ++ ".tar.gz"     return ()-      where-        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)-                              copyFile specFile (thisKitDir </> "KitSpec")     doVerify :: String -> Command ()   doVerify sdk = do@@ -96,10 +95,20 @@   handleArgs KA.ShowTree = doShowTree    kitMain :: IO ()-  kitMain = let f = do-                      mkdirP =<< defaultLocalRepoPath -                      runCommand . handleArgs =<< KA.parseArgs-            in catch f $ \e -> do-                alert $ show e-                exitWith $ ExitFailure 1 +  kitMain = do+    let f = runCommand . handleArgs =<< KA.parseArgs+    h <- getHomeDirectory+    fs <- inDirectory h $ glob ".kit/repository/kits/*/*/*.tar.gz"+    let c = length fs+    when (c > 0) $ do+      say Red $ "Warning: Kit now expects packages in '.kit/cache/local' instead of '.kit/repository/kits'. (Found " ++ show c ++ " packages in the old location.)"+      puts ""+      say Red "To fix it, move the old directory into the new path:"+      say Red "\t$ mkdir -p ~/.kit/cache/local"+      say Red "\t$ mv ~/.kit/repository/kits/* ~/.kit/cache/local"+      say Red "\t$ rmdir ~/.kit/repository/kits && rmdir ~/.kit/repository"+      puts ""+    catch f $ \e -> do+        alert $ show e+        exitWith $ ExitFailure 1
Kit/Project.hs view
@@ -1,15 +1,11 @@ {-# LANGUAGE TupleSections #-} module Kit.Project (-  totalSpecDependencies,-  unpackKit,-  generateKitProjectFromSpecs,-  dependencyTree+  writeKitProjectFromContents   )     where  import Kit.Spec import Kit.Contents-import Kit.Repository import Kit.Util import Kit.Util.FSAction import Kit.Xcode.Builder@@ -17,14 +13,11 @@  import Control.Monad.Error import Data.Maybe-import Data.List import qualified Data.Map as M-import Data.Tree-import System.Cmd  -- Paths -kitDir, projectDir, prefixFile, projectFile, xcodeConfigFile, depsConfigFile, kitUpdateMakeFilePath :: FilePath+kitDir, projectDir, prefixFile, projectFile, xcodeConfigFile, depsConfigFile, kitUpdateMakeFilePath, kitResourceDir :: FilePath  kitDir = "." </> "Kits" projectDir = "KitDeps.xcodeproj"@@ -33,6 +26,7 @@ xcodeConfigFile = "Kit.xcconfig" depsConfigFile = "DepsOnly.xcconfig" kitUpdateMakeFilePath = "Makefile"+kitResourceDir = "Resources"  kitUpdateMakeFile :: String kitUpdateMakeFile = "kit: Kit.xcconfig\n" ++@@ -53,34 +47,39 @@   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-  when (not . null . kitProjectResourceDirs $ kp) $ do-    puts $ " -> Linking resources: " ++ stringJoin ", " (map fst $ kitProjectResourceDirs kp)-    mapM_ (\(tgt,name) -> runAction $ Symlink tgt name) $ kitProjectResourceDirs kp+writeKitProjectFromContents :: [KitContents] -> Maybe String -> FilePath -> KitIO ()+writeKitProjectFromContents contents depsOnlyConfig packagesDirectory = writeKitProject $ makeKitProject contents depsOnlyConfig packagesDirectory -generateKitProjectFromSpecs :: [KitSpec] -> Maybe String -> KitIO ()-generateKitProjectFromSpecs specs depsOnlyConfig = do-  kp <- generateXcodeProject specs depsOnlyConfig -  generateKitProject kp+writeKitProject :: KitProject -> KitIO ()+writeKitProject kp = do+    liftIO $ mapM_ (runAction . within kitDir) [+          FileCreate projectFile (kitProjectFile kp),+          FileCreate prefixFile (kitProjectPrefix kp),+          FileCreate xcodeConfigFile (kitProjectConfig kp),+          FileCreate kitUpdateMakeFilePath kitUpdateMakeFile,+          FileCreate depsConfigFile (kitProjectDepsConfig kp)+        ]+    mkdirP kitDir+    liftIO $ inDirectory kitDir $ do+      let resourceDirs = kitProjectResourceDirs kp+      unless (null resourceDirs) $ do+        puts $ " -> Linking resources: " ++ stringJoin ", " (map fst resourceDirs)+        mapM_ (\(tgt,name) -> runAction $ Symlink tgt name) resourceDirs -generateXcodeProject :: [KitSpec] -> Maybe String -> KitIO KitProject -generateXcodeProject specs depsOnlyConfig = do-  liftIO $ inDirectory kitDir $ do-    currentDir <- getCurrentDirectory-    kitsContents <- mapM (fmap (makeContentsRelative currentDir) . readKitContents) 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+resourceLink :: KitContents -> Maybe (FilePath, FilePath) +resourceLink contents = let specResources = contentResourceDir contents+                            linkName = kitResourceDir </> packageName (contentSpec contents)+                         in (,linkName) <$> specResources++makeKitProject :: [KitContents] -> Maybe String -> FilePath -> KitProject+makeKitProject kitsContents depsOnlyConfig packagesDirectory = +  let pf = createProjectFile kitsContents+      header = createHeader kitsContents+      config = createConfig kitsContents+  -- TODO: Make this specify an xcconfig+      depsConfig = "#include \"" ++ xcodeConfigFile ++ "\"\n\nSKIP_INSTALL=YES\n\n" ++ fromMaybe "" depsOnlyConfig +      resources = mapMaybe resourceLink kitsContents+   in KitProject pf header config depsConfig resources   where createProjectFile cs = do           let headers = concatMap contentHeaders cs           let sources = concatMap contentSources cs@@ -91,7 +90,7 @@           let combinedHeader = stringJoin "\n" headers           prefixDefault ++ combinedHeader ++ "\n"         createConfig cs = do-          let sourceDirs = map (\spec -> packageFileName spec </> specSourceDirectory spec) specs >>= (\s -> [s, kitDir </> s])+          let sourceDirs = map ((\spec -> packageFileName spec </> specSourceDirectory spec) . contentSpec) cs >>= (\s -> [s, packagesDirectory </> s])           let configs = mapMaybe contentConfig cs           let parentConfig = XCC "Base" (M.fromList [                                                     ("HEADER_SEARCH_PATHS", "$(HEADER_SEARCH_PATHS) " ++ stringJoin " " sourceDirs),@@ -100,35 +99,4 @@                                                   ]) []           let combinedConfig = multiConfig "KitConfig" (parentConfig:configs)           configToString combinedConfig ++ "\n"--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]-refineDeps = nub . concat . reverse . drop 1 . levels---- todo: check for conflicts--- todo: check for version ranges :)-totalSpecDependencies :: KitRepository -> KitSpec -> KitIO [KitSpec]-totalSpecDependencies kr spec = refineDeps <$> unfoldTreeM (unfoldDeps kr) spec--dependencyTree :: KitRepository -> KitSpec -> KitIO (Tree KitSpec)-dependencyTree kr spec = unfoldTreeM (unfoldDeps kr) spec--unfoldDeps :: KitRepository -> KitSpec -> KitIO (KitSpec, [KitSpec])-unfoldDeps kr ks = (ks,) <$> mapM (readKitSpec kr) (specDependencies ks) -- s/mapM/traverse ?--unpackKit :: KitRepository -> Kit -> IO ()-unpackKit kr kit = do-    tmpDir <- getTemporaryDirectory-    let fp = tmpDir </> (packageFileName kit ++ ".tar.gz")-    putStrLn $ " -> Installing " ++ packageFileName kit-    copyKitPackage kr kit fp-    mkdirP kitDir -    inDirectory kitDir $ system ("tar zxf " ++ fp)-    return ()
Kit/Repository.hs view
@@ -1,11 +1,15 @@ {-# LANGUAGE PackageImports #-} module Kit.Repository (     ---    KitRepository(KitRepository),+    KitRepository,+    makeRepository,     --     copyKitPackage,     explodePackage,-    readKitSpec+    readKitSpec,+    unpackKit,+    packagesDirectory,+    publishLocally   ) where    import Kit.Spec@@ -17,36 +21,74 @@   import qualified Data.Traversable as T   import qualified Data.ByteString as BS -  data KitRepository = KitRepository { repositoryBase :: FilePath } deriving (Eq, Show)+  data KitRepository = KitRepository { dotKitDir :: FilePath } deriving (Eq, Show) +  localCacheDir :: KitRepository -> FilePath+  localCacheDir kr = dotKitDir kr </> "cache" </> "local"++  makeRepository :: FilePath -> IO KitRepository+  makeRepository fp = do +    let kr = KitRepository fp+    mkdirP $ localCacheDir kr+    return kr+   explodePackage :: KitRepository -> Kit -> IO ()   explodePackage kr kit = do-    let packagesDir = repositoryBase kr </> "kits"-    let packagePath = repositoryBase kr </> kitPackagePath kit+    let packagesDir = localCacheDir kr+    let packagePath = localCacheDir 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+  copyKitPackage repo kit = copyFile (localCacheDir repo </> kitPackagePath kit)    readKitSpec :: KitRepository -> Kit -> KitIO KitSpec   readKitSpec repo kit = do-    mbKitStuff <- liftIO $ doRead repo (kitSpecPath kit)+    mbKitStuff <- liftIO $ readIfExists (localCacheDir repo </> kitSpecPath kit)     maybe (throwError $ "Missing " ++ packageFileName kit) f mbKitStuff     where f contents = maybeToKitIO ("Invalid KitSpec file for " ++ packageFileName kit) $ decodeSpec contents -  doRead :: KitRepository -> String -> IO (Maybe BS.ByteString) -  doRead (KitRepository baseDir) fp = let file = (baseDir </> fp) in do+  readIfExists :: String -> IO (Maybe BS.ByteString) +  readIfExists file = do     exists <- doesFileExist file     T.sequenceA $ ifTrue exists $ BS.readFile file    baseKitPath :: Kit -> String-  baseKitPath k = stringJoin "/" ["kits", kitName k, kitVersion k] +  baseKitPath k = kitName k </> kitVersion k    kitPackagePath :: Kit -> String-  kitPackagePath k = baseKitPath k ++ "/" ++ packageFileName k ++ ".tar.gz"+  kitPackagePath k = baseKitPath k </> packageFileName k ++ ".tar.gz"    kitSpecPath :: Kit -> String-  kitSpecPath k = baseKitPath k ++ "/" ++ "KitSpec"+  kitSpecPath k = baseKitPath k </> "KitSpec"++  packagesDirectory :: KitRepository -> FilePath+  packagesDirectory kr = dotKitDir kr </> "packages"++  unpackKit :: KitRepository -> Kit -> IO ()+  unpackKit kr kit = do+      let source = (localCacheDir kr </> kitPackagePath kit)+      let dest = packagesDirectory kr+      d <- doesDirectoryExist $ dest </> packageFileName kit+      if not d then do+          putStrLn $ " -> Unpacking from cache: " ++ packageFileName kit+          mkdirP dest +          inDirectory dest $ system ("tar zxf " ++ source)+          return ()+        else +          putStrLn $ " -> Using local package: " ++ packageFileName kit+      return ()++  -- TODO: on publish local, need to flush this particular name/version out+  -- of the packages dir if it exists, so if this is overriding a version, that+  -- all works.+  publishLocally :: KitRepository -> KitSpec -> FilePath -> FilePath -> IO ()+  publishLocally kr ks specFile packageFile = do+                              let cacheDir = localCacheDir kr+                              let thisKitDir = cacheDir </> baseKitPath (specKit ks)+                              mkdirP thisKitDir+                              let fname = takeFileName packageFile+                              copyFile packageFile (thisKitDir </> fname)+                              copyFile specFile (thisKitDir </> "KitSpec")
Kit/Spec.hs view
@@ -22,6 +22,8 @@   import Kit.Util.IsObject   import qualified Data.ByteString as BS    import qualified Data.Object.Yaml as Y+  import Data.Maybe (maybeToList)+  import Control.Arrow ((&&&))    data KitSpec = KitSpec {     specKit :: Kit,@@ -63,7 +65,7 @@   -- TODO make this and the json reading use the same defaults   -- I suspect that to do this I'll need update functions for each of   -- fields in the KitSpec record.-  -- Look at the 'lenses' package on hackage.+  -- Look at the 'lenses' package on hackage. (or comonad-transformers)    decodeSpec :: BS.ByteString -> Maybe KitSpec   decodeSpec s = Y.decode s >>= readObject @@ -81,20 +83,28 @@     readObject x = fromMapping x >>= \obj -> (Kit <$> obj #> "name" <*> obj #> "version") <|> case obj of                                                                                                     [(key, Scalar value)] -> Just $ Kit key value   -- TODO this + ReadObject should be identity+  -- TODO don't write out default values   instance ShowObject KitSpec where-    showObject spec = Mapping [-         "name" ~> (val $ kitName . specKit),-         "version" ~> (val $ kitVersion . specKit),-         "dependencies" ~> showObject (specDependencies spec),-         "source-directory" ~> val specSourceDirectory -      ] where a ~> b = (a, b)-              val f = Scalar . f $ spec+    showObject spec = Mapping ([+         "name" ~> val (kitName . specKit),+         "version" ~> val (kitVersion . specKit),+         "dependencies" ~> Sequence (map makeDep (specDependencies spec)),+         "source-directory" ~> val specSourceDirectory,+         "test-directory" ~> val specTestDirectory,+         "lib-directory" ~> val specLibDirectory,+         "resources-directory" ~> val specResourcesDirectory,+         "prefix-header" ~> val specPrefixFile,+         "xcconfig" ~> val specConfigFile+      ] ++ maybeToList (fmap (("kitdeps-xcode-flags" ~>) . Scalar) (specKitDepsXcodeFlags spec)))+      where a ~> b = (a, b)+            val f = Scalar . f $ spec+            makeDep dep = Mapping [(kitName dep, Scalar $ kitVersion dep)]    instance ReadObject KitSpec where     readObject x = fromMapping x >>= parser         where or' a b = a <|> pure b               parser obj =  KitSpec <$> readObject x-                                    <*> (obj #> "dependencies" `or'` [])+                                    <*> (obj #> "dependencies" `or'` []) -- TODO this should fail if it can't read the format                                     <*> (obj #> "source-directory" `or'` "src")                                     <*> (obj #> "test-directory" `or'` "test")                                     <*> (obj #> "lib-directory" `or'` "lib")
Kit/Util.hs view
@@ -5,7 +5,8 @@   module Control.Applicative,   module Control.Monad,   module System.Directory,-  module System.FilePath.Posix+  module System.FilePath.Posix,+  Color(..)   ) where   import System.Directory   import System.FilePath.Posix@@ -14,13 +15,16 @@   import Data.List   import Data.Maybe   import Data.Monoid+  import Data.Traversable as T    import Control.Applicative   import Control.Monad-  import Control.Monad.Error+  import "mtl" Control.Monad.Error -  import qualified Control.Monad.State as S+  import System.Console.ANSI +  import qualified "mtl" Control.Monad.State as S+   popS :: S.State [a] a   popS = do     (x:t) <- S.get@@ -73,3 +77,22 @@   stringJoin :: Monoid a => a -> [a] -> a   stringJoin x = mconcat . intersperse x   +  -- | Lifting bind into a monad. Often denoted /concatMapM/.+  (.=<<.) ::+    (Monad q, Monad m, Traversable m) =>+    (a -> q (m b))+    -> m a+    -> q (m b)+  (.=<<.) f =+    liftM join . T.mapM f+    +  +  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+
+ Kit/WorkingCopy.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE PackageImports, TupleSections #-}+module Kit.WorkingCopy (+    WorkingCopy(..),+    currentWorkingCopy,+    isDevPackage,+    devKitDir+    ) where++import Kit.Util+import Kit.Spec++import "mtl" Control.Monad.Trans+import "mtl" Control.Monad.Error+import qualified Data.ByteString as BS++devKitDir :: String+devKitDir = "dev-packages"++data WorkingCopy = WorkingCopy {+  workingKitSpec :: KitSpec,+  workingSpecFile :: FilePath,+  workingDevPackages :: [(FilePath, KitSpec)]+} deriving (Eq, Show)++currentWorkingCopy :: KitIO WorkingCopy+currentWorkingCopy = do+  let specFile = "KitSpec"+  spec <- readSpec specFile+  devKitSpecFiles <- liftIO $ glob "dev-packages/*/KitSpec"+  let f path = (takeFileName . takeDirectory $ path,) <$> readSpec path+  devKitSpecs <- mapM f devKitSpecFiles+  return $ WorkingCopy spec specFile devKitSpecs++isDevPackage :: WorkingCopy -> KitSpec -> Bool+isDevPackage wc spec = any (\s -> packageName spec == packageName s) $ map snd (workingDevPackages wc)++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/Xcode/Common.hs view
@@ -46,13 +46,14 @@ fileReferenceItem fr = fileReferenceId fr ~> dict   where     fileName = fileReferenceName fr+    path = fileReferencePath fr     dict = obj [         "isa" ~> val "PBXFileReference",         "fileEncoding" ~> val "4",         "lastKnownFileType" ~> val (fileType fileName),         "name" ~> val fileName,-        "path" ~> val (fileReferencePath fr),-        "sourceTree" ~> val "<group>"+        "path" ~> val path,+        "sourceTree" ~> val (if (isAbsolute path) then "<absolute" else "<group>")       ]  fileReferenceName :: PBXFileReference -> String
kit.cabal view
@@ -1,5 +1,5 @@ name:           kit-version:        0.6.8+version:        0.7.0 cabal-version:  >=1.2 build-type:     Simple license:        BSD3@@ -23,5 +23,6 @@   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.Util.FSAction+                  Kit.Contents Kit.Commands Kit.CmdArgs Kit.Util.IsObject Kit.Util.FSAction Kit.WorkingCopy+                  Kit.Dependency   Ghc-options:    -Wall -fno-warn-unused-do-bind