kit 0.7.9 → 0.7.10
raw patch · 17 files changed
+184/−236 lines, 17 filesdep +errorsdep −HTTPdep −bytestringdep −networkdep ~Globdep ~cmdargs
Dependencies added: errors
Dependencies removed: HTTP, bytestring, network, template-haskell
Dependency ranges changed: Glob, cmdargs
Files
- Kit/AbsolutePath.hs +15/−0
- Kit/Commands.hs +10/−16
- Kit/Contents.hs +12/−17
- Kit/Dependency.hs +20/−19
- Kit/FilePath.hs +0/−15
- Kit/Main.hs +12/−15
- Kit/Package.hs +3/−3
- Kit/Project.hs +2/−4
- Kit/Repository.hs +13/−34
- Kit/Spec.hs +9/−21
- Kit/Util.hs +38/−45
- Kit/Util/FSAction.hs +5/−3
- Kit/WorkingCopy.hs +7/−12
- Kit/Xcode/Builder.hs +19/−14
- Kit/Xcode/Common.hs +5/−4
- Text/PList/PrettyPrint.hs +8/−5
- kit.cabal +6/−9
+ Kit/AbsolutePath.hs view
@@ -0,0 +1,15 @@+module Kit.AbsolutePath (+ AbsolutePath,+ filePath,+ absolutePath+ ) where++import System.Directory (canonicalizePath)++data AbsolutePath = AbsolutePath FilePath deriving (Eq, Show)++filePath :: AbsolutePath -> FilePath+filePath (AbsolutePath fp) = fp++absolutePath :: FilePath -> IO AbsolutePath+absolutePath path = fmap AbsolutePath $ canonicalizePath path
Kit/Commands.hs view
@@ -1,29 +1,25 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, PackageImports #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Kit.Commands ( Command(), liftKit, mySpec, myWorkingCopy, myRepository,- runCommand,- defaultLocalRepository+ runCommand ) where import Kit.Util import Kit.Spec import Kit.Repository import Kit.WorkingCopy--import System.Exit (exitFailure)--import "mtl" Control.Monad.Error-import "mtl" Control.Monad.Reader+import Control.Monad.Reader+import Control.Error newtype Command a = Command { - unCommand :: (ReaderT (WorkingCopy, KitRepository) (ErrorT String IO) a) + unCommand :: ReaderT (WorkingCopy, KitRepository) Script a } deriving (Monad, MonadIO, Functor, Applicative) -liftKit :: KitIO a -> Command a+liftKit :: Script a -> Command a liftKit = Command . ReaderT . const mySpec :: Command KitSpec@@ -35,13 +31,11 @@ myRepository :: Command KitRepository myRepository = Command $ fmap snd ask -runCommand :: Maybe FilePath -> Command a -> IO ()-runCommand repository (Command cmd) = run $ do+runCommand :: Maybe FilePath -> Command a -> IO a+runCommand repository (Command cmd) = runScript $ do spec <- currentWorkingCopy- repository <- liftIO $ maybe defaultLocalRepository makeRepository repository- runReaderT cmd (spec, repository)- where run = (handleFails =<<) . runErrorT- handleFails = either (\msg -> putStrLn ("kit error: " ++ msg) >> exitFailure) (const $ return ())+ rep <- liftIO $ maybe defaultLocalRepository makeRepository repository+ runReaderT cmd (spec, rep) defaultLocalRepository :: IO KitRepository defaultLocalRepository = makeRepository =<< (</> ".kit" ) <$> getHomeDirectory
Kit/Contents.hs view
@@ -7,17 +7,16 @@ import Kit.Spec import Kit.Util import Kit.Xcode.XCConfig-import Kit.FilePath--import qualified Data.Traversable as T+import Kit.AbsolutePath+import Kit.FlaggedFile -- | The determined contents of a particular Kit data KitContents = KitContents { contentSpec :: KitSpec, -- ^ The dependency the contents were created from contentBaseDir :: FilePath, -- ^ Path to where the content was loaded from- contentHeaders :: [FilePath], -- ^ Paths to headers- contentSources :: [FilePath], -- ^ Paths to source files- contentLibs :: [FilePath], -- ^ Paths to static libs+ contentHeaders :: [FlaggedFile], -- ^ Paths to headers+ contentSources :: [FlaggedFile], -- ^ Paths to source files+ contentLibs :: [FlaggedFile], -- ^ Paths to static libs contentConfig :: Maybe XCConfig, -- ^ Contents of the xcconfig base file contentPrefix :: Maybe String, -- ^ Contents of the prefix header contentResourceDir :: Maybe FilePath@@ -33,9 +32,10 @@ readKitContents :: (Applicative m, MonadIO m) => AbsolutePath -> KitSpec -> m KitContents readKitContents absKitDir spec = let kitDir = filePath absKitDir - find dir tpe = liftIO $ inDirectory kitDir $ do- files <- glob (dir </> "**/*" ++ tpe)- mapM canonicalizePath files+ -- We need to flag every file with objc-arc or not, if we do it+ -- project wide things get really messy.+ flags = if specWithARC spec then "-fobjc-arc" else "-fno-objc-arc"+ find dir tpe = fmap (flaggedFile flags) <$> findFiles kitDir dir tpe findSrc = find $ specSourceDirectory spec headers = findSrc ".h" sources = findSrc .=<<. [".m", ".mm", ".c"]@@ -48,20 +48,15 @@ if b then Just <$> canonicalizePath r else return Nothing- in KitContents spec kitDir <$> headers <*> sources <*> libs <*> config <*> prefix <*> resourceDir+ in KitContents spec kitDir <$> headers <*> sources <*> libs <*> config <*> prefix <*> resourceDir -- TODO report missing file 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)+readHeader kitDir spec = readFile' $ kitDir </> specPrefixFile spec -- TODO report missing file 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)+ contents <- readFile' $ kitDir </> specConfigFile spec return $ fmap (fileContentsToXCC $ packageName spec) contents
Kit/Dependency.hs view
@@ -5,19 +5,18 @@ dependency, depSpec, isDevDep,- dependencyTree,- devKitDir -- TODO, cleanup main, might not need to export+ dependencyTree ) where +import Control.Error import Kit.Util import Kit.Spec import Kit.Repository import Kit.WorkingCopy import Data.Tree (Tree, levels, unfoldTreeM) import Data.List (nub)-import Data.Maybe (isJust) -data Dependency = Dependency { depSpec :: KitSpec, mbKitPath :: (Maybe FilePath) } deriving (Eq, Show)+data Dependency = Dependency { depSpec :: KitSpec, mbKitPath :: Maybe FilePath } deriving (Eq, Show) -- Fold over a dependency dependency :: (KitSpec -> a) -> (FilePath -> KitSpec -> a) -> Dependency -> a@@ -31,30 +30,32 @@ isDevDep :: Dependency -> Bool isDevDep = isJust . mbKitPath +-- todo: check for version ranges :)+totalSpecDependencies :: KitRepository -> WorkingCopy -> Script [Dependency]+totalSpecDependencies repo workingCopy = refineDeps <$> dependencyTree repo workingCopy+ -- | 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 version ranges :)-totalSpecDependencies :: KitRepository -> WorkingCopy -> KitIO [Dependency]-totalSpecDependencies repo workingCopy = refineDeps <$> dependencyTree repo workingCopy--dependencyTree :: KitRepository -> WorkingCopy -> KitIO (Tree Dependency)+dependencyTree :: KitRepository -> WorkingCopy -> Script (Tree Dependency) dependencyTree repo workingCopy = unfoldTreeM (unfoldDeps repo devPackages) baseSpec where devPackages = workingDevPackages workingCopy baseSpec = workingKitSpec workingCopy +unfoldDeps :: KitRepository -> DevPackages -> KitSpec -> Script (Dependency, [KitSpec])+unfoldDeps kr devPackages = unfolder (mapM (lookupX kr devPackages) . specDependencies . depSpec) . lookupDependency devPackages + lookupDependency :: DevPackages -> KitSpec -> Dependency-lookupDependency devPackages ks = maybe (Dependency ks Nothing) (\(ks',fp) -> Dependency ks' (Just fp)) thisDev- where thisDev = findDevPackage devPackages ks+lookupDependency devPackages ks = maybe (Dependency ks Nothing) (\(devSpec,fp) -> Dependency devSpec (Just fp)) thisDev+ where thisDev = findDevPackage devPackages ks -findKitSpec :: DevPackages -> Kit -> Maybe KitSpec-findKitSpec devPackages kit = fmap fst $ findDevPackage devPackages kit+unfolder :: Functor m => (a -> m b) -> a -> m (a, b)+unfolder f b = (b,) <$> f b -unfoldDeps :: KitRepository -> DevPackages -> KitSpec -> KitIO (Dependency, [KitSpec])-unfoldDeps kr devPackages spec = let rootDep = lookupDependency devPackages spec- lookup' kit = maybe (readKitSpec kr kit) return $ findKitSpec devPackages kit - in do- children <- mapM lookup' . specDependencies . depSpec $ rootDep- return (rootDep, children)+lookupX :: MonadIO m => KitRepository -> DevPackages -> Kit -> EitherT String m KitSpec+lookupX kr devPackages kit = maybe (readKitSpec kr kit) return $ findDevKitSpec devPackages kit ++findDevKitSpec :: DevPackages -> Kit -> Maybe KitSpec+findDevKitSpec devPackages kit = fmap fst $ findDevPackage devPackages kit
− Kit/FilePath.hs
@@ -1,15 +0,0 @@-module Kit.FilePath (- AbsolutePath,- filePath,- absolutePath- ) where--import System.Directory (canonicalizePath)--data AbsolutePath = AbsolutePath FilePath deriving (Eq, Show)--filePath :: AbsolutePath -> FilePath-filePath (AbsolutePath fp) = fp--absolutePath :: FilePath -> IO AbsolutePath-absolutePath path = fmap AbsolutePath $ canonicalizePath path
Kit/Main.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PackageImports #-} module Kit.Main where import qualified Kit.CmdArgs as KA @@ -10,6 +9,7 @@ import Kit.Contents import Kit.Dependency import Kit.WorkingCopy+ import Data.Yaml (encodeFile) import Kit.Util.FSAction import System.Exit import Data.Tree (drawTree)@@ -17,15 +17,12 @@ import Data.Function (on) import Kit.Repository (KitRepository, unpackKit, packagesDirectory, publishLocally) import Control.Monad.State- import Kit.FilePath+ import Kit.AbsolutePath kitMain :: IO () kitMain = do args <- KA.parseArgs- let action = runCommand (KA.repositoryDir args) . handleArgs $ args- catch action $ \e -> do- sayError $ show e- exitWith $ ExitFailure 1 + runCommand (KA.repositoryDir args) . handleArgs $ args handleArgs :: KA.KitCmdArgs -> Command () handleArgs (KA.Update _) = doUpdate@@ -43,7 +40,7 @@ rawDeps <- totalSpecDependencies repo workingCopy (deps, didResolveConflict) <- unconflict rawDeps let (devPackages, repoPackages) = partition isDevDep deps- mapM_ (unpackKit repo) repoPackages+ mapM_ (liftIO . unpackKit repo) repoPackages mapM_ (sayError . ("Using dev-package: " ++) . packageName) devPackages project <- buildProject repo workingCopy deps reportResources project@@ -58,14 +55,14 @@ writeProject = liftIO . runActions . kitProjectActions unconflict :: (Packageable b, MonadIO m) => [b] -> m ([b], Bool)- unconflict deps = let byName = groupBy ((==) `on` (packageName . snd)) . sortBy (compare `on` (packageName . snd)) $ zip [1..] deps+ unconflict deps = let byName = groupBy ((==) `on` (packageName . snd)) . sortBy (compare `on` (packageName . snd)) $ zip [(1::Int)..] deps stripIndex (xs, hadConflict) = (map snd . sortBy (compare `on` fst) $ xs, hadConflict)- in liftM stripIndex $ flip runStateT False $ forM byName $ \all@(b:bs) ->+ in liftM stripIndex $ flip runStateT False $ forM byName $ \allDeps@(b:bs) -> if null bs then return b else do- let versions = nub $ map (packageVersion . snd) all- let maxVersion = maximumBy (compare `on` (packageVersion . snd)) all+ let versions = nub $ map (packageVersion . snd) allDeps+ let maxVersion = maximumBy (compare `on` (packageVersion . snd)) allDeps sayWarn $ "Dependency conflict: " ++ packageName (snd b) ++ " => " ++ intercalate ", " versions sayWarn $ "Selected maximum version: " ++ (packageVersion . snd $ maxVersion) put True@@ -73,7 +70,7 @@ dependencyContents :: (Applicative m, MonadIO m) => KitRepository -> Dependency -> m KitContents dependencyContents repo dep = readKitContents' baseDir (depSpec dep) where- baseDir = dependency ((packagesDirectory repo </>) . packageFileName) (\fp spec -> devKitDir </> fp) dep+ baseDir = dependency ((packagesDirectory repo </>) . packageFileName) (\fp _ -> devKitDir </> fp) dep readKitContents' base spec = do absoluteBase <- liftIO $ absolutePath base readKitContents absoluteBase spec@@ -106,11 +103,11 @@ puts " #> Deploying locally" doPublishLocal Nothing -- TODO publish with a verify tag puts " #> Building temporary parent project"- liftIO $ inDirectory getTemporaryDirectory $ do+ liftIO $ inDirectoryM getTemporaryDirectory $ do let kitVerifyDir = "kit-verify" cleanOrCreate kitVerifyDir inDirectory kitVerifyDir $ do- writeSpec "KitSpec" (defaultSpec "verify-kit" "1.0") { specDependencies = [specKit spec] }+ encodeFile "KitSpec" (defaultSpec "verify-kit" "1.0") { specDependencies = [specKit spec] } runCommand Nothing doUpdate inDirectory "Kits" $ do shell "open ."@@ -121,6 +118,6 @@ doCreateSpec :: String -> String -> Command () doCreateSpec name version = do let spec = defaultSpec name version - writeSpec "KitSpec" spec+ liftIO $ encodeFile "KitSpec" spec puts $ "Created KitSpec for " ++ packageFileName spec
Kit/Package.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PackageImports #-} module Kit.Package (package) where import Kit.Spec import Kit.Util@@ -6,14 +5,15 @@ fileBelongsInPackage :: KitSpec -> FilePath -> Bool fileBelongsInPackage config fp = isCore || isProject where- isCore = elem fp [specResourcesDirectory config, specSourceDirectory config, specTestDirectory config, specLibDirectory config, "KitSpec"]+ isCore = fp `elem` [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 package :: KitSpec -> IO () package spec = do contents <- filter (fileBelongsInPackage spec) <$> getDirectoryContents "." mkdirP distDir- sh $ envDontCopy ++ " tar -czf " ++ (distDir </> (kitPath ++ ".tar.gz")) ++ " -s ,^," ++ kitPath ++ "/, " ++ join (intersperse " " contents)+ let escapedContents = map (\x -> "\"" ++ x ++ "\"") contents+ sh $ envDontCopy ++ " tar -czf " ++ (distDir </> (kitPath ++ ".tar.gz")) ++ " -s ,^," ++ kitPath ++ "/, " ++ join (intersperse " " escapedContents) return () where distDir = "dist"
Kit/Project.hs view
@@ -12,8 +12,6 @@ import Kit.Util.FSAction import Kit.Xcode.Builder import Kit.Xcode.XCConfig-import Data.List-import Data.Function import Data.Maybe import qualified Data.Map as M @@ -74,8 +72,8 @@ resources = mapMaybe resourceLink kitsContents in KitProject pf header config depsConfig resources where createProjectFile cs = let- headers = sortBy (compare `on` takeFileName) (concatMap contentHeaders cs)- sources = sortBy (compare `on` takeFileName) (concatMap contentSources cs)+ headers = concatMap contentHeaders cs+ sources = concatMap contentSources cs libs = concatMap contentLibs cs in renderXcodeProject headers sources libs "libKitDeps.a" createHeader cs = let
Kit/Repository.hs view
@@ -1,11 +1,8 @@-{-# LANGUAGE PackageImports #-} module Kit.Repository ( -- KitRepository, makeRepository, --- copyKitPackage,- explodePackage, readKitSpec, unpackKit, packagesDirectory,@@ -14,9 +11,8 @@ import Kit.Spec import Kit.Util-- import qualified Data.Traversable as T- import qualified Data.ByteString as BS+ import Data.Yaml (decodeFile)+ import Control.Error data KitRepository = KitRepository { dotKitDir :: FilePath } deriving (Eq, Show) @@ -28,27 +24,10 @@ mkdirP $ localCacheDir repo return repo - explodePackage :: KitRepository -> Kit -> IO ()- explodePackage kr kit = do- let packagesDir = localCacheDir kr- let packagePath = localCacheDir kr </> kitPackagePath kit- mkdirP packagesDir- inDirectory packagesDir $ shell ("tar zxvf " ++ packagePath)- return ()-- copyKitPackage :: KitRepository -> Kit -> FilePath -> IO ()- copyKitPackage repo kit = copyFile (localCacheDir repo </> kitPackagePath kit)-- readKitSpec :: KitRepository -> Kit -> KitIO KitSpec+ readKitSpec :: MonadIO m => KitRepository -> Kit -> EitherT String m KitSpec readKitSpec repo kit = do- mbKitStuff <- liftIO $ readIfExists (localCacheDir repo </> kitSpecPath kit)- contents <- maybeToKitIO ("Missing " ++ packageFileName kit) mbKitStuff- maybeToKitIO ("Invalid KitSpec file for " ++ packageFileName kit) $ decodeSpec contents-- readIfExists :: String -> IO (Maybe BS.ByteString)- readIfExists file = do- exists <- doesFileExist file- T.sequenceA $ ifTrue exists $ BS.readFile file+ mbLoaded <- liftIO $ decodeFile (localCacheDir repo </> kitSpecPath kit)+ tryJust ("Invalid KitSpec file for " ++ packageFileName kit) mbLoaded baseKitPath :: Packageable a => a -> String baseKitPath k = packageName k </> packageVersion k@@ -62,29 +41,29 @@ packagesDirectory :: KitRepository -> FilePath packagesDirectory kr = dotKitDir kr </> "packages" - unpackKit :: (Packageable a, MonadIO m) => KitRepository -> a -> m ()+ unpackKit :: (Packageable a) => KitRepository -> a -> IO () unpackKit kr kit = do- let source = (localCacheDir kr </> kitPackagePath kit)+ let source = localCacheDir kr </> kitPackagePath kit let dest = packagesDirectory kr- d <- liftIO $ doesDirectoryExist $ dest </> packageFileName kit+ d <- doesDirectoryExist $ dest </> packageFileName kit if not d then do- puts $ "Unpacking: " ++ packageFileName kit+ putStrLn $ "Unpacking: " ++ packageFileName kit mkdirP dest - liftIO $ inDirectory dest $ shell ("tar zxf " ++ source)+ inDirectory dest $ shell ("tar zxf " ++ source) return ()- else puts $ "Using: " ++ packageFileName kit+ else putStrLn $ "Using: " ++ packageFileName kit return () publishLocally :: KitRepository -> KitSpec -> FilePath -> FilePath -> IO () publishLocally kr ks specFile packageFile = do let cacheDir = localCacheDir kr- let thisKitDir = cacheDir </> baseKitPath (specKit ks)+ let thisKitDir = cacheDir </> baseKitPath ks mkdirP thisKitDir let fname = takeFileName packageFile copyFile packageFile (thisKitDir </> fname) copyFile specFile (thisKitDir </> "KitSpec")- let pkg = packagesDirectory kr </> packageFileName (specKit ks)+ let pkg = packagesDirectory kr </> packageFileName ks d <- doesDirectoryExist pkg when d $ removeDirectoryRecursive pkg
Kit/Spec.hs view
@@ -8,19 +8,13 @@ Packageable(..), packageFileName, -- | Utils- defaultSpec,- -- | Serialisation- decodeSpec,- encodeSpec,- writeSpec+ defaultSpec ) where import Kit.Util- import Data.Yaml import Data.HashMap.Strict as HM (toList) import Data.Text as T (unpack, pack)- import qualified Data.ByteString as BS import Data.Maybe (maybeToList) import Data.Attoparsec.Number @@ -33,6 +27,7 @@ specResourcesDirectory :: FilePath, specPrefixFile :: FilePath, specConfigFile :: FilePath,+ specWithARC :: Bool, specKitDepsXcodeFlags :: Maybe String } deriving (Show, Read, Eq) @@ -60,26 +55,17 @@ packageVersion = kitVersion . specKit defaultSpec :: String -> String -> KitSpec- defaultSpec name version = KitSpec (Kit name version) [] "src" "test" "lib" "resources" "Prefix.pch" "Config.xcconfig" Nothing + defaultSpec name version = KitSpec (Kit name version) [] "src" "test" "lib" "resources" "Prefix.pch" "Config.xcconfig" False Nothing -- 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 'data-lens' package on hackage. (or comonad-transformers) - decodeSpec :: BS.ByteString -> Maybe KitSpec- decodeSpec = decode-- encodeSpec :: KitSpec -> BS.ByteString- encodeSpec = encode-- writeSpec :: MonadIO m => FilePath -> KitSpec -> m ()- writeSpec fp spec = liftIO $ BS.writeFile fp $ encodeSpec spec- instance ToJSON Kit where toJSON kit = object ["name" .= kitName kit, "version" .= kitVersion kit] showNum :: Number -> String- showNum l = show l+ showNum = show instance FromJSON Kit where parseJSON (Object obj) = (Kit <$> obj .: "name" <*> (obj .: "version" <|> (showNum <$> obj .: "version"))) <|> case HM.toList obj of@@ -93,14 +79,15 @@ toJSON spec = object ([ "name" .= (kitName . specKit) spec, "version" .= (kitVersion . specKit) spec,- "dependencies" .= (map makeDep (specDependencies spec)),+ "dependencies" .= map makeDep (specDependencies spec), "source-directory" .= specSourceDirectory spec, "test-directory" .= specTestDirectory spec, "lib-directory" .= specLibDirectory spec, "resources-directory" .= specResourcesDirectory spec, "prefix-header" .= specPrefixFile spec,+ "with-arc" .= specWithARC spec, "xcconfig" .= specConfigFile spec- ] ++ maybeToList (fmap (("kitdeps-xcode-flags" .=)) (specKitDepsXcodeFlags spec)))+ ] ++ maybeToList (fmap ("kitdeps-xcode-flags" .=) (specKitDepsXcodeFlags spec))) where makeDep dep = object [(T.pack $ kitName dep, String . T.pack $ kitVersion dep)] instance FromJSON KitSpec where@@ -112,5 +99,6 @@ <*> (obj .:? "resources-directory" .!= "resources") <*> (obj .:? "prefix-header" .!= "Prefix.pch") <*> (obj .:? "xcconfig" .!= "Config.xcconfig")+ <*> (obj .:? "with-arc" .!= False) <*> (Just <$> obj .:? "kitdeps-xcode-flags") .!= Nothing-+ parseJSON _ = fail "Couldn't parse KitSpec"
Kit/Util.hs view
@@ -1,37 +1,34 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, PackageImports #-}- module Kit.Util( module Kit.Util,- module Control.Applicative,- module Control.Monad,- module System.Directory,- module System.FilePath.Posix,- module Control.Monad.Trans,+ module Exported, Color(..),- (>>>)+ (</>), takeFileName, takeDirectory,+ tryJust ) where+ + import Control.Applicative as Exported+ import Control.Monad.Trans as Exported+ import Control.Monad as Exported+ import System.Directory as Exported - import System.Directory- import System.FilePath.Posix+ import System.FilePath.Posix ((</>), takeFileName, takeDirectory) import System.FilePath.Glob (globDir1, compile) - import System.Posix.Env (getEnv)+ import System.Environment (getEnv) + import Control.Error+ import Data.List- import Data.Maybe import Data.Monoid import Data.Traversable as T - import Control.Arrow- import Control.Applicative- import Control.Monad- import Control.Monad.Error- import Control.Monad.Trans import System.Cmd + import Kit.AbsolutePath+ import System.Console.ANSI - import qualified "mtl" Control.Monad.State as S+ import Control.Monad.State as S popS :: S.State [a] a popS = do@@ -40,33 +37,17 @@ return x shell :: String -> IO ()- shell c = do- _ <- system c- return ()+ shell = void . system 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+ puts = liftIO . putStrLn 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-- maybeToLeft :: b -> Maybe a -> Either a b- maybeToLeft v = maybe (Right v) Left-- type KitIO a = ErrorT String IO a- - maybeToKitIO :: String -> Maybe a -> KitIO a- maybeToKitIO msg = maybe (throwError msg) return- mkdirP :: MonadIO m => FilePath -> m () mkdirP = liftIO . createDirectoryIfMissing True @@ -75,21 +56,25 @@ exists <- doesDirectoryExist directory when exists $ removeDirectoryRecursive directory mkdirP directory-- -- Typeclass so that inDirectory can act on effectful values- class FilePathM a where filePathM :: MonadIO m => a -> m FilePath- instance FilePathM FilePath where filePathM = return - instance FilePathM (IO FilePath) where filePathM = liftIO . id - inDirectory :: (FilePathM p, MonadIO m) => p -> m a -> m a+ inDirectory :: MonadIO m => FilePath -> m a -> m a inDirectory fp actions = do cwd <- liftIO getCurrentDirectory- dir <- filePathM fp- liftIO $ setCurrentDirectory dir+ liftIO $ setCurrentDirectory fp v <- actions liftIO $ setCurrentDirectory cwd return v + inDirectoryM :: (MonadIO m) => m FilePath -> m a -> m a+ inDirectoryM m a = do+ v <- m+ inDirectory v a++ findFiles :: MonadIO m => FilePath -> FilePath -> String -> m [AbsolutePath]+ findFiles kitDir dir tpe = liftIO $ inDirectory kitDir $ do+ files <- glob (dir </> "**/*" ++ tpe)+ T.mapM absolutePath files+ glob :: String -> IO [String] glob pattern = globDir1 (compile pattern) "" @@ -105,8 +90,11 @@ (.=<<.) f = liftM join . T.mapM f + getEnv' :: String -> IO (Maybe String)+ getEnv' = fmap hush . runEitherT . tryIO . getEnv+ isSet :: String -> IO Bool- isSet = fmap isJust . getEnv + isSet = fmap isJust . getEnv' say :: MonadIO m => Color -> String -> m () say color msg = do@@ -124,4 +112,9 @@ sayWarn :: MonadIO m => String -> m () sayWarn = say Yellow++ readFile' :: (MonadPlus t, T.Traversable t) => FilePath -> IO (t String)+ readFile' fp = do+ exists <- doesFileExist fp+ T.sequence (fmap readFile $ ifTrue exists fp)
Kit/Util/FSAction.hs view
@@ -3,6 +3,8 @@ import System.FilePath import System.Posix.Files +import Control.Error+ import Kit.Util import Data.List (intersperse) @@ -22,13 +24,13 @@ renameFile tempPath atPath where tempPath = atPath ++ "_" runAction (Symlink target name) = do- catch (removeLink name) (\_ -> return ())+ _ <- runEitherT . scriptIO $ removeLink name -- When a `name` has parent directories, symbolic link target needs to be made relative to that file -- need to consider "./name" let relFix = join $ intersperse "/" $ map (const "..") (init $ splitDirectories name) mkdirP $ dropFileName name- catch (when' (fileExist target) $ createSymbolicLink (relFix </> target) name) $ \e -> do- error $ "An error occured when creating a symlink to " ++ target ++ " called " ++ name ++ ": " ++ show e+ let printError e = "An error occured when creating a symlink to " ++ target ++ " called " ++ name ++ ": " ++ show e+ runScript . fmapLT printError . scriptIO $ when' (fileExist target) (createSymbolicLink (relFix </> target) name) runAction (InDir dir action) = do mkdirP dir
Kit/WorkingCopy.hs view
@@ -8,11 +8,10 @@ ) where import Kit.Util+import Data.Yaml (decodeFile) import Kit.Spec import qualified Data.List as L--import "mtl" Control.Monad.Error-import qualified Data.ByteString as BS+import Control.Error devKitDir :: String devKitDir = "dev-packages"@@ -28,7 +27,7 @@ findDevPackage :: Packageable a => DevPackages -> a -> Maybe (KitSpec, FilePath) findDevPackage (DevPackages pkgs) kit = L.find ((packageName kit ==) . packageName . fst) pkgs -currentWorkingCopy :: KitIO WorkingCopy+currentWorkingCopy :: Script WorkingCopy currentWorkingCopy = do let specFile = "KitSpec" spec <- readSpec specFile@@ -37,11 +36,7 @@ devKitSpecs <- mapM f devKitSpecFiles return $ WorkingCopy spec specFile $ DevPackages devKitSpecs -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+readSpec :: FilePath -> Script KitSpec+readSpec path = do+ mbKitSpec <- liftIO $ decodeFile path+ tryJust ("Error loading spec file " ++ path) mbKitSpec
Kit/Xcode/Builder.hs view
@@ -2,28 +2,33 @@ module Kit.Xcode.Builder (renderXcodeProject) where import Kit.Xcode.Common import Kit.Xcode.ProjectFileTemplate+ import Kit.FlaggedFile import Text.PList- import qualified Text.PList.PrettyPrint as PList (pp, ppFlat)+ import qualified Text.PList.PrettyPrint as PList (ppFlat) import Kit.Util- import Data.List (nub)+ import Data.List (nub, sortBy) import "mtl" Control.Monad.State+ import System.FilePath+ import Data.Function (on) - createBuildFile :: Integer -> FilePath -> PBXBuildFile- createBuildFile i path = PBXBuildFile uuid1 $ PBXFileReference uuid2 path+ createBuildFile :: Integer -> FlaggedFile -> PBXBuildFile+ createBuildFile i ffpath = PBXBuildFile uuid1 (PBXFileReference uuid2 path) compileFlags where uuid1 = uuid i uuid2 = uuid $ i + 10000000+ path = flaggedFilePath ffpath+ compileFlags = flaggedFileFlags ffpath - buildFileFromState :: FilePath -> State [Integer] PBXBuildFile+ buildFileFromState :: FlaggedFile -> State [Integer] PBXBuildFile buildFileFromState filePath = flip createBuildFile filePath <$> popS -- | Render an Xcode project! renderXcodeProject :: - [FilePath] -- ^ Headers - -> [FilePath] -- ^ Sources- -> [FilePath] -- ^ Static Libs+ [FlaggedFile] -- ^ Headers + -> [FlaggedFile] -- ^ Sources+ -> [FlaggedFile] -- ^ Static Libs -> String -- ^ Output lib name -> String - renderXcodeProject headers sources libs outputLibName = fst . flip runState [1..] $ do+ renderXcodeProject headers sources libs outputLibName = fst . flip runState [(1::Integer)..] $ do headerBuildFiles <- mapM buildFileFromState headers sourceBuildFiles <- mapM buildFileFromState sources libBuildFiles <- mapM buildFileFromState libs -- Build File Items@@ -32,21 +37,21 @@ bfs = buildFileSection allBuildFiles frs = fileReferenceSection (map buildFileReference allBuildFiles) outputLibName -- Groups- classes = classesGroup $ map buildFileReference (sourceBuildFiles ++ headerBuildFiles)+ classes = classesGroup $ sortBy (compare `on` (takeFileName . fileReferencePath)) $ map buildFileReference (sourceBuildFiles ++ headerBuildFiles) fg = frameworksGroup $ map buildFileReference libBuildFiles -- Phases headersPhase = headersBuildPhase headerBuildFiles srcsPhase = sourcesBuildPhase sourceBuildFiles frameworksPhase = frameworksBuildPhase libBuildFiles -- UUID indices- libDirs = nub $ map dropFileName libs + libDirs = nub $ map (dropFileName . flaggedFilePath) libs return . PList.ppFlat $ makeProjectPList (bfs ++ frs ++ [classes, headersPhase, srcsPhase, frameworksPhase, fg]) libDirs buildFileSection :: [PBXBuildFile] -> [PListObjectItem] buildFileSection bfs = map buildFileItem bfs ++ [- "4728C530117C02B10027D7D1" ~> buildFile kitConfigRefUUID,- "AA747D9F0F9514B9006C5449" ~> buildFile "AA747D9E0F9514B9006C5449",- "AACBBE4A0F95108600F1A2B1" ~> buildFile "AACBBE490F95108600F1A2B1"+ "4728C530117C02B10027D7D1" ~> buildFile kitConfigRefUUID "",+ "AA747D9F0F9514B9006C5449" ~> buildFile "AA747D9E0F9514B9006C5449" "",+ "AACBBE4A0F95108600F1A2B1" ~> buildFile "AACBBE490F95108600F1A2B1" "" ] fileReferenceSection :: [PBXFileReference] -> String -> [PListObjectItem]
Kit/Xcode/Common.hs view
@@ -20,7 +20,8 @@ data PBXBuildFile = PBXBuildFile { buildFileId :: UUID,- buildFileReference :: PBXFileReference+ buildFileReference :: PBXFileReference,+ buildFileFlags :: String } deriving (Eq, Show) data PBXFileReference = PBXFileReference {@@ -36,11 +37,11 @@ "children" ~> arr children ] -buildFile :: String -> PListType-buildFile refUUID = obj [ "isa" ~> val "PBXBuildFile", "fileRef" ~> val refUUID ]+buildFile :: String -> String -> PListType+buildFile refUUID flags = obj [ "isa" ~> val "PBXBuildFile", "fileRef" ~> val refUUID, "settings" ~> obj ["COMPILER_FLAGS" ~> val flags ]] buildFileItem :: PBXBuildFile -> PListObjectItem -buildFileItem bf = buildFileId bf ~> buildFile (fileReferenceId . buildFileReference $ bf) +buildFileItem bf = buildFileId bf ~> (buildFile (fileReferenceId . buildFileReference $ bf) (buildFileFlags bf)) fileReferenceItem :: PBXFileReference -> PListObjectItem fileReferenceItem fr = fileReferenceId fr ~> dict
Text/PList/PrettyPrint.hs view
@@ -7,11 +7,11 @@ import Kit.Xcode.Common -import "mtl" Control.Monad.Writer (Writer, runWriter, tell)+import "mtl" Control.Monad.Writer (MonadWriter, Writer, runWriter, tell) import "mtl" Control.Monad.State (StateT, get, put, runStateT) pp :: PListFile -> String-pp (PListFile charset root value) = "// " ++ charset ++ "\n" ++ printValue (obj value) ++ "\n"+pp (PListFile charset _ value) = "// " ++ charset ++ "\n" ++ printValue (obj value) ++ "\n" printItem :: PListObjectItem -> [Char] printItem (PListObjectItem k v) = k ++ " = " ++ printValue v ++ ";\n"@@ -41,15 +41,19 @@ ("rootObject", FlatStr root) ] +seedKeys :: [UUID] seedKeys = map uuid [50000..] printFlat :: FlatDocument -> String printFlat = printFlatItem . FlatObj +quoteIf :: String -> String quoteIf a = if quotable a then quote a else a +xxx :: ([Char], FlatItem) -> [Char] xxx (k,v) = k ++ " = " ++ printFlatItem v ++ ";\n" +printFlatItem :: FlatItem -> String printFlatItem (FlatStr a) = quoteIf a printFlatItem (FlatArr xs) = "(" ++ join (intersperse ", " $ map quoteIf xs) ++ ")" printFlatItem (FlatObj kvs) = "{\n" ++ (kvs >>= (\x -> " " ++ xxx x)) ++ "}\n"@@ -93,10 +97,9 @@ put xs return x -writeToRef ref obj = tell [(ref, obj)]-+writeObj :: FlatItem -> StateT [String] (Writer [(String, FlatItem)]) String writeObj o = do r <- readRef- writeToRef r o+ tell [(r,o)] return r
kit.cabal view
@@ -1,5 +1,5 @@ name: kit-version: 0.7.9+version: 0.7.10 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -15,29 +15,26 @@ main-is: Main.hs buildable: True build-depends: base >=3 && <5,- Glob >= 0.5.1 && < 6, + Glob >= 0.7.1, attoparsec,- HTTP, ansi-terminal >= 0.5.5,- bytestring -any, cabal-file-th >= 0.2.2,- cmdargs >= 0.6.2,+ cmdargs >= 0.9.6, containers -any, + errors >= 1.3.1, yaml, directory -any, filepath -any, mtl -any,- network -any, process -any,- template-haskell, unordered-containers, text,- unix + unix 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 Text.PList.PrettyPrint- Kit.Contents Kit.Commands Kit.CmdArgs Kit.Util.FSAction Kit.WorkingCopy Kit.FilePath+ Kit.Contents Kit.Commands Kit.CmdArgs Kit.Util.FSAction Kit.WorkingCopy Kit.AbsolutePath Kit.Dependency Ghc-options: -Wall