diff --git a/Kit/CmdArgs.hs b/Kit/CmdArgs.hs --- a/Kit/CmdArgs.hs +++ b/Kit/CmdArgs.hs @@ -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 diff --git a/Kit/Commands.hs b/Kit/Commands.hs --- a/Kit/Commands.hs +++ b/Kit/Commands.hs @@ -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 diff --git a/Kit/Contents.hs b/Kit/Contents.hs --- a/Kit/Contents.hs +++ b/Kit/Contents.hs @@ -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 diff --git a/Kit/Main.hs b/Kit/Main.hs --- a/Kit/Main.hs +++ b/Kit/Main.hs @@ -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." diff --git a/Kit/Package.hs b/Kit/Package.hs --- a/Kit/Package.hs +++ b/Kit/Package.hs @@ -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 diff --git a/Kit/Project.hs b/Kit/Project.hs --- a/Kit/Project.hs +++ b/Kit/Project.hs @@ -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 \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 diff --git a/Kit/Repository.hs b/Kit/Repository.hs --- a/Kit/Repository.hs +++ b/Kit/Repository.hs @@ -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" diff --git a/Kit/Spec.hs b/Kit/Spec.hs --- a/Kit/Spec.hs +++ b/Kit/Spec.hs @@ -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 diff --git a/Kit/Util.hs b/Kit/Util.hs --- a/Kit/Util.hs +++ b/Kit/Util.hs @@ -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 diff --git a/Kit/Util/FSAction.hs b/Kit/Util/FSAction.hs new file mode 100644 --- /dev/null +++ b/Kit/Util/FSAction.hs @@ -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 + diff --git a/kit.cabal b/kit.cabal --- a/kit.cabal +++ b/kit.cabal @@ -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