kit 0.7.8 → 0.7.9
raw patch · 19 files changed
+426/−340 lines, 19 filesdep +attoparsecdep +textdep +unordered-containersdep −data-objectdep −data-object-yamldep ~HTTPdep ~cabal-file-thdep ~mtl
Dependencies added: attoparsec, text, unordered-containers, yaml
Dependencies removed: data-object, data-object-yaml
Dependency ranges changed: HTTP, cabal-file-th, mtl, unix
Files
- Kit/CmdArgs.hs +12/−14
- Kit/Commands.hs +6/−6
- Kit/Contents.hs +10/−6
- Kit/Dependency.hs +14/−20
- Kit/FilePath.hs +15/−0
- Kit/Main.hs +62/−61
- Kit/Package.hs +3/−2
- Kit/Project.hs +5/−4
- Kit/Repository.hs +12/−20
- Kit/Spec.hs +44/−43
- Kit/Util.hs +23/−9
- Kit/Util/FSAction.hs +3/−0
- Kit/Util/IsObject.hs +0/−25
- Kit/WorkingCopy.hs +0/−1
- Kit/Xcode/Builder.hs +5/−5
- Kit/Xcode/ProjectFileTemplate.hs +75/−82
- Text/PList.hs +24/−33
- Text/PList/PrettyPrint.hs +102/−0
- kit.cabal +11/−9
Kit/CmdArgs.hs view
@@ -7,31 +7,29 @@ appVersion :: String appVersion = $(packageVariable (pkgVersion . package)) - data KitCmdArgs = Update- | Package- | Info- | PublishLocal { tag :: Maybe String } - | Verify { sdk :: String }- | CreateSpec { name :: String, version :: String } - | ShowTree+ data KitCmdArgs = Update { repositoryDir :: Maybe String }+ | Package { repositoryDir :: Maybe String }+ | PublishLocal { tag :: Maybe String, repositoryDir :: Maybe String }+ | Verify { sdk :: String, repositoryDir :: Maybe String}+ | CreateSpec { name :: String, version :: String, repositoryDir :: Maybe String } + | ShowTree { repositoryDir :: Maybe String } deriving (Show, Data, Typeable) parseMode :: KitCmdArgs parseMode = modes [- Update &= help "Create an Xcode project to wrap the dependencies defined in `KitSpec`"+ Update def &= help "Create an Xcode project to wrap the dependencies defined in `KitSpec`" &= auto -- The default mode to run. This is most common usage.- , CreateSpec { Kit.CmdArgs.name = (def &= typ "NAME") &= argPos 0, version = (def &= typ "VERSION") &= argPos 1 } &=+ , CreateSpec { repositoryDir = def, Kit.CmdArgs.name = (def &= typ "NAME") &= argPos 0, version = (def &= typ "VERSION") &= argPos 1 } &= explicit &= CA.name "create-spec" &= help "Write out a KitSpec file using the given name and version."- , Info &= help "Show name and version of this kit"- , Package &=+ , Package def &= help "Create a tar.gz wrapping this kit"- , PublishLocal { tag = Nothing } &= explicit &= CA.name "publish-local" &=+ , PublishLocal { repositoryDir = def, tag = Nothing } &= explicit &= CA.name "publish-local" &= help "Package this kit, then deploy it to the local repository (~/.kit/repository)"- , Verify { sdk = "iphonesimulator4.0" &= typ "SDK" &= help "iphoneos, iphonesimulator4.0, etc."} &=+ , Verify { repositoryDir = def, sdk = "iphonesimulator" &= typ "SDK" &= help "iphoneos, iphonesimulator, etc."} &= help "Package this kit, then attempt to use it as a dependency in an empty project. This will assert that the kit and all its dependencies can be compiled together."- , ShowTree &= help "Print out the dependency tree for this spec"+ , ShowTree def &= help "Print out the dependency tree for this spec" ] parseArgs :: IO KitCmdArgs
Kit/Commands.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, PackageImports #-} module Kit.Commands ( Command(), liftKit,@@ -16,8 +16,8 @@ import System.Exit (exitFailure) -import Control.Monad.Error-import Control.Monad.Reader+import "mtl" Control.Monad.Error+import "mtl" Control.Monad.Reader newtype Command a = Command { unCommand :: (ReaderT (WorkingCopy, KitRepository) (ErrorT String IO) a) @@ -35,10 +35,10 @@ myRepository :: Command KitRepository myRepository = Command $ fmap snd ask -runCommand :: Command a -> IO ()-runCommand (Command cmd) = run $ do+runCommand :: Maybe FilePath -> Command a -> IO ()+runCommand repository (Command cmd) = run $ do spec <- currentWorkingCopy- repository <- liftIO defaultLocalRepository+ repository <- liftIO $ maybe defaultLocalRepository makeRepository repository runReaderT cmd (spec, repository) where run = (handleFails =<<) . runErrorT handleFails = either (\msg -> putStrLn ("kit error: " ++ msg) >> exitFailure) (const $ return ())
Kit/Contents.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE PackageImports #-} module Kit.Contents ( KitContents(..), readKitContents,@@ -8,7 +7,7 @@ import Kit.Spec import Kit.Util import Kit.Xcode.XCConfig-import "mtl" Control.Monad.Trans+import Kit.FilePath import qualified Data.Traversable as T @@ -24,12 +23,17 @@ contentResourceDir :: Maybe FilePath } +instance Packageable KitContents where+ packageName = packageName . contentSpec+ packageVersion = packageVersion . contentSpec+ namedPrefix :: KitContents -> Maybe String-namedPrefix kc = fmap (\s -> "//" ++ (packageFileName . contentSpec $ kc) ++ "\n" ++ s) $ contentPrefix kc+namedPrefix kc = fmap (\s -> "//" ++ packageFileName kc ++ "\n" ++ s) $ contentPrefix kc -readKitContents :: (Applicative m, MonadIO m) => FilePath -> KitSpec -> m KitContents-readKitContents kitDir spec =- let find dir tpe = liftIO $ inDirectory kitDir $ do+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 findSrc = find $ specSourceDirectory spec
Kit/Dependency.hs view
@@ -13,28 +13,28 @@ import Kit.Spec import Kit.Repository import Kit.WorkingCopy-import Data.Tree-import Data.List+import Data.Tree (Tree, levels, unfoldTreeM)+import Data.List (nub)+import Data.Maybe (isJust) -data Location = Repo | Dev FilePath deriving (Eq, Show)-data Dependency = Dependency KitSpec Location deriving (Eq, Show)+data Dependency = Dependency { depSpec :: KitSpec, mbKitPath :: (Maybe FilePath) } deriving (Eq, Show) -dependency :: (KitSpec -> a) -> (KitSpec -> FilePath -> a) -> Dependency -> a-dependency f _ (Dependency spec Repo) = f spec-dependency _ f (Dependency spec (Dev fp)) = f spec fp+-- Fold over a dependency+dependency :: (KitSpec -> a) -> (FilePath -> KitSpec -> a) -> Dependency -> a+dependency repoDepF _ (Dependency spec Nothing) = repoDepF spec+dependency _ f (Dependency spec (Just fp)) = f fp spec -depSpec :: Dependency -> KitSpec-depSpec (Dependency k _) = k+instance Packageable Dependency where + packageName = packageName . depSpec+ packageVersion = packageVersion . depSpec isDevDep :: Dependency -> Bool-isDevDep (Dependency _ Repo) = False-isDevDep (Dependency _ (Dev _)) = True+isDevDep = isJust . mbKitPath -- | 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@@ -45,21 +45,15 @@ baseSpec = workingKitSpec workingCopy lookupDependency :: DevPackages -> KitSpec -> Dependency-lookupDependency devPackages ks = maybe (Dependency ks Repo) (\(ks',fp) -> Dependency ks' (Dev fp)) thisDev+lookupDependency devPackages ks = maybe (Dependency ks Nothing) (\(ks',fp) -> Dependency ks' (Just fp)) thisDev where thisDev = findDevPackage devPackages ks findKitSpec :: DevPackages -> Kit -> Maybe KitSpec findKitSpec devPackages kit = fmap fst $ findDevPackage devPackages kit -class KitSpecContainer a where- lookupKit :: a -> Kit -> KitIO KitSpec--instance KitSpecContainer KitRepository where lookupKit = readKitSpec-instance KitSpecContainer DevPackages where lookupKit dp = maybeToKitIO "Not a dev package" . findKitSpec dp- unfoldDeps :: KitRepository -> DevPackages -> KitSpec -> KitIO (Dependency, [KitSpec]) unfoldDeps kr devPackages spec = let rootDep = lookupDependency devPackages spec- lookup' kit = lookupKit devPackages kit <|> lookupKit kr kit+ lookup' kit = maybe (readKitSpec kr kit) return $ findKitSpec devPackages kit in do children <- mapM lookup' . specDependencies . depSpec $ rootDep return (rootDep, children)
+ Kit/FilePath.hs view
@@ -0,0 +1,15 @@+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,6 +1,6 @@+{-# LANGUAGE PackageImports #-} module Kit.Main where - import Control.Monad.Trans import qualified Kit.CmdArgs as KA import Kit.Commands import Kit.Spec@@ -13,44 +13,71 @@ import Kit.Util.FSAction import System.Exit import Data.Tree (drawTree)- import Data.List (partition)+ import Data.List (partition, groupBy, sortBy, maximumBy, nub, intercalate)+ import Data.Function (on) import Kit.Repository (KitRepository, unpackKit, packagesDirectory, publishLocally)+ import Control.Monad.State+ import Kit.FilePath - loadKitFromBase :: (Applicative m, MonadIO m) => FilePath -> FilePath -> KitSpec -> m KitContents- loadKitFromBase base kitDir spec = do- absoluteBase <- liftIO $ canonicalizePath base- readKitContents (absoluteBase </> kitDir) spec+ 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 - dependencyContents :: (Applicative m, MonadIO m) => KitRepository -> Dependency -> m KitContents- dependencyContents repo dep = dependency inRepo local dep where -- TODO look at all these applications of dep- inRepo spec = loadKitFromBase (packagesDirectory repo) (packageFileName spec) spec- local spec fp = loadKitFromBase devKitDir fp spec+ handleArgs :: KA.KitCmdArgs -> Command ()+ handleArgs (KA.Update _) = doUpdate+ handleArgs (KA.Package _) = doPackageKit+ handleArgs (KA.PublishLocal _ versionTag) = doPublishLocal versionTag + handleArgs (KA.Verify sdkName _) = doVerify sdkName+ handleArgs (KA.CreateSpec name version _) = doCreateSpec name version+ handleArgs (KA.ShowTree _) = doShowTree doUpdate :: Command () doUpdate = do repo <- myRepository workingCopy <- myWorkingCopy- let spec = workingKitSpec workingCopy liftKit $ do- deps <- totalSpecDependencies repo workingCopy- let (devPackages, notDevPackages) = partition isDevDep deps- mapM_ ((unpackKit repo . specKit) . depSpec) notDevPackages- mapM_ (\s -> say Red $ " -> Using dev package: " ++ packageName (depSpec s)) devPackages- puts " -> Generating Xcode project..."+ rawDeps <- totalSpecDependencies repo workingCopy+ (deps, didResolveConflict) <- unconflict rawDeps+ let (devPackages, repoPackages) = partition isDevDep deps+ mapM_ (unpackKit repo) repoPackages+ mapM_ (sayError . ("Using dev-package: " ++) . packageName) devPackages+ project <- buildProject repo workingCopy deps+ reportResources project+ writeProject project+ (if didResolveConflict then sayWarn else say Green) "Kit complete. You may need to restart Xcode for it to pick up any changes."+ liftIO . when didResolveConflict . exitWith . ExitFailure $ 1+ where buildProject repo workingCopy deps = do allContents <- mapM (dependencyContents repo) deps- let project = makeKitProject allContents (specKitDepsXcodeFlags spec)- let resourceDirs = kitProjectResourceDirs project- unless (null resourceDirs) $ puts $ " -> Linked resources: " ++ stringJoin ", " (map fst resourceDirs)- liftIO $ mapM_ runAction $ kitProjectActions project- say Green "\n\tKit complete. You may need to restart Xcode for it to pick up any changes.\n"+ return $ makeKitProject allContents (specKitDepsXcodeFlags (workingKitSpec workingCopy))+ reportResources project = let resourceDirs = kitProjectResourceDirs project+ in unless (null resourceDirs) $ puts $ "Resources: " ++ stringJoin ", " (map fst resourceDirs)+ writeProject = liftIO . runActions . kitProjectActions - doShowTree :: Command ()- doShowTree = do- repo <- myRepository- wc <- myWorkingCopy- tree <- liftKit $ dependencyTree repo wc- puts $ drawTree $ fmap (packageFileName . depSpec) tree+ 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+ stripIndex (xs, hadConflict) = (map snd . sortBy (compare `on` fst) $ xs, hadConflict)+ in liftM stripIndex $ flip runStateT False $ forM byName $ \all@(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+ sayWarn $ "Dependency conflict: " ++ packageName (snd b) ++ " => " ++ intercalate ", " versions+ sayWarn $ "Selected maximum version: " ++ (packageVersion . snd $ maxVersion)+ put True+ return maxVersion + 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+ readKitContents' base spec = do+ absoluteBase <- liftIO $ absolutePath base+ readKitContents absoluteBase spec+ doPackageKit :: Command () doPackageKit = mySpec >>= liftIO . package @@ -65,11 +92,13 @@ publishLocally repo updatedSpec specFile $ "dist" </> packageFileName updatedSpec ++ ".tar.gz" return () - doInfo :: Command()- doInfo = do- spec <- mySpec- puts $ packageFileName spec- + doShowTree :: Command ()+ doShowTree = do+ repo <- myRepository+ wc <- myWorkingCopy+ tree <- liftKit $ dependencyTree repo wc+ puts $ drawTree $ fmap packageFileName tree+ doVerify :: String -> Command () doVerify sdk = do spec <- mySpec@@ -82,7 +111,7 @@ cleanOrCreate kitVerifyDir inDirectory kitVerifyDir $ do writeSpec "KitSpec" (defaultSpec "verify-kit" "1.0") { specDependencies = [specKit spec] }- runCommand doUpdate + runCommand Nothing doUpdate inDirectory "Kits" $ do shell "open ." shell $ "xcodebuild -sdk " ++ sdk@@ -94,32 +123,4 @@ let spec = defaultSpec name version writeSpec "KitSpec" spec puts $ "Created KitSpec for " ++ packageFileName spec-- handleArgs :: KA.KitCmdArgs -> Command ()- handleArgs KA.Update = doUpdate- handleArgs KA.Package = doPackageKit- handleArgs KA.Info = doInfo- handleArgs (KA.PublishLocal versionTag) = doPublishLocal versionTag - handleArgs (KA.Verify sdkName) = doVerify sdkName- handleArgs (KA.CreateSpec name version) = doCreateSpec name version- handleArgs KA.ShowTree = doShowTree-- warnOldRepo :: MonadIO m => Int -> m ()- warnOldRepo c = 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 ""-- kitMain :: IO ()- kitMain = do- let f = runCommand . handleArgs =<< KA.parseArgs- fs <- inDirectory getHomeDirectory $ glob ".kit/repository/kits/*/*/*.tar.gz"- unless (null fs) $ warnOldRepo (length fs)- catch f $ \e -> do- alert $ show e- exitWith $ ExitFailure 1
Kit/Package.hs view
@@ -1,7 +1,7 @@+{-# LANGUAGE PackageImports #-} module Kit.Package (package) where import Kit.Spec import Kit.Util- import Control.Monad.Trans import Data.List fileBelongsInPackage :: KitSpec -> FilePath -> Bool@@ -13,10 +13,11 @@ package spec = do contents <- filter (fileBelongsInPackage spec) <$> getDirectoryContents "." mkdirP distDir- sh $ "tar -czf " ++ (distDir </> (kitPath ++ ".tar.gz")) ++ " -s ,^," ++ kitPath ++ "/, " ++ join (intersperse " " contents)+ sh $ envDontCopy ++ " tar -czf " ++ (distDir </> (kitPath ++ ".tar.gz")) ++ " -s ,^," ++ kitPath ++ "/, " ++ join (intersperse " " contents) return () where distDir = "dist" kitPath = packageFileName spec+ envDontCopy = "COPYFILE_DISABLE=true " sh c = liftIO $ putStrLn c >> shell c
Kit/Project.hs view
@@ -12,7 +12,8 @@ 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 @@ -61,7 +62,7 @@ resourceLink :: KitContents -> Maybe (FilePath, FilePath) resourceLink contents = fmap (,linkName) $ contentResourceDir contents where - linkName = kitResourceDir </> packageName (contentSpec contents)+ linkName = kitResourceDir </> packageName contents makeKitProject :: [KitContents] -> Maybe String -> KitProject makeKitProject kitsContents depsOnlyConfig = @@ -73,8 +74,8 @@ resources = mapMaybe resourceLink kitsContents in KitProject pf header config depsConfig resources where createProjectFile cs = let- headers = concatMap contentHeaders cs- sources = concatMap contentSources cs+ headers = sortBy (compare `on` takeFileName) (concatMap contentHeaders cs)+ sources = sortBy (compare `on` takeFileName) (concatMap contentSources cs) libs = concatMap contentLibs cs in renderXcodeProject headers sources libs "libKitDeps.a" createHeader cs = let
Kit/Repository.hs view
@@ -9,16 +9,12 @@ readKitSpec, unpackKit, packagesDirectory,- publishLocally,-- -- Exposed for resolve, split this stuff out into a separate module- kitPackagePath+ publishLocally ) where import Kit.Spec import Kit.Util - import "mtl" Control.Monad.Error import qualified Data.Traversable as T import qualified Data.ByteString as BS @@ -28,10 +24,9 @@ localCacheDir kr = dotKitDir kr </> "cache" </> "local" makeRepository :: FilePath -> IO KitRepository- makeRepository fp = do - let kr = KitRepository fp- mkdirP $ localCacheDir kr- return kr+ makeRepository fp = let repo = KitRepository fp in do + mkdirP $ localCacheDir repo+ return repo explodePackage :: KitRepository -> Kit -> IO () explodePackage kr kit = do@@ -55,35 +50,32 @@ exists <- doesFileExist file T.sequenceA $ ifTrue exists $ BS.readFile file - baseKitPath :: Kit -> String- baseKitPath k = kitName k </> kitVersion k+ baseKitPath :: Packageable a => a -> String+ baseKitPath k = packageName k </> packageVersion k - kitPackagePath :: Kit -> String+ kitPackagePath :: Packageable a => a -> String kitPackagePath k = baseKitPath k </> packageFileName k ++ ".tar.gz" - kitSpecPath :: Kit -> String+ kitSpecPath :: Packageable a => a -> String kitSpecPath k = baseKitPath k </> "KitSpec" packagesDirectory :: KitRepository -> FilePath packagesDirectory kr = dotKitDir kr </> "packages" - unpackKit :: MonadIO m => KitRepository -> Kit -> m ()+ unpackKit :: (Packageable a, MonadIO m) => KitRepository -> a -> m () unpackKit kr kit = do let source = (localCacheDir kr </> kitPackagePath kit) let dest = packagesDirectory kr d <- liftIO $ doesDirectoryExist $ dest </> packageFileName kit if not d then do- puts $ " -> Unpacking from cache: " ++ packageFileName kit+ puts $ "Unpacking: " ++ packageFileName kit mkdirP dest liftIO $ inDirectory dest $ shell ("tar zxf " ++ source) return ()- else puts $ " -> Using local package: " ++ packageFileName kit+ else puts $ "Using: " ++ 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@@ -91,7 +83,7 @@ mkdirP thisKitDir let fname = takeFileName packageFile copyFile packageFile (thisKitDir </> fname)- copyFile specFile (thisKitDir </> "KitSpec") + copyFile specFile (thisKitDir </> "KitSpec") let pkg = packagesDirectory kr </> packageFileName (specKit ks) d <- doesDirectoryExist pkg when d $ removeDirectoryRecursive pkg
Kit/Spec.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE PackageImports #-}+{-# LANGUAGE OverloadedStrings #-} module Kit.Spec ( -- | The Core Kit types KitSpec(..),@@ -15,14 +15,14 @@ writeSpec ) where - import Control.Applicative- import "mtl" Control.Monad.Trans+ import Kit.Util - import Data.Object- import Kit.Util.IsObject+ import Data.Yaml+ import Data.HashMap.Strict as HM (toList) + import Data.Text as T (unpack, pack) import qualified Data.ByteString as BS - import qualified Data.Object.Yaml as Y import Data.Maybe (maybeToList)+ import Data.Attoparsec.Number data KitSpec = KitSpec { specKit :: Kit,@@ -64,52 +64,53 @@ -- 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. (or comonad-transformers)+ -- Look at the 'data-lens' package on hackage. (or comonad-transformers) decodeSpec :: BS.ByteString -> Maybe KitSpec- decodeSpec s = Y.decode s >>= readObject + decodeSpec = decode encodeSpec :: KitSpec -> BS.ByteString- encodeSpec = Y.encode . showObject+ encodeSpec = encode writeSpec :: MonadIO m => FilePath -> KitSpec -> m () writeSpec fp spec = liftIO $ BS.writeFile fp $ encodeSpec spec - instance ShowObject Kit where- showObject kit = Mapping [("name", w kitName), ("version", w kitVersion)] where w f = showObject . f $ kit+ instance ToJSON Kit where+ toJSON kit = object ["name" .= kitName kit, "version" .= kitVersion kit] - instance ReadObject Kit where- readObject x = fromMapping x >>= \obj -> (Kit <$> obj #> "name" <*> obj #> "version") <|> case obj of- [(key, Scalar value)] -> Just $ Kit key value- _ -> Nothing- -- TODO this + ReadObject should be identity+ showNum :: Number -> String+ showNum l = show l++ instance FromJSON Kit where+ parseJSON (Object obj) = (Kit <$> obj .: "name" <*> (obj .: "version" <|> (showNum <$> obj .: "version"))) <|> case HM.toList obj of+ [(key, String value)] -> pure $ Kit (T.unpack key) (T.unpack value)+ [(key, Number value)] -> pure $ Kit (T.unpack key) (show value)+ x -> error $ "Not a compatible object" ++ show x+ parseJSON x = error $ "NOT A OBJ" ++ show x+ -- TODO don't write out default values- instance ShowObject KitSpec where- 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 ToJSON KitSpec where+ toJSON spec = object ([+ "name" .= (kitName . specKit) spec,+ "version" .= (kitVersion . specKit) 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,+ "xcconfig" .= specConfigFile spec+ ] ++ maybeToList (fmap (("kitdeps-xcode-flags" .=)) (specKitDepsXcodeFlags spec)))+ where makeDep dep = object [(T.pack $ kitName dep, String . T.pack $ 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'` []) -- 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")- <*> (obj #> "resources-directory" `or'` "resources")- <*> (obj #> "prefix-header" `or'` "Prefix.pch")- <*> (obj #> "xcconfig" `or'` "Config.xcconfig")- <*> (Just <$> obj #> "kitdeps-xcode-flags") `or'` Nothing+ instance FromJSON KitSpec where+ parseJSON (Object obj) = KitSpec <$> parseJSON (Object obj)+ <*> (obj .:? "dependencies" .!= []) -- TODO this should fail if it can't read the format+ <*> (obj .:? "source-directory" .!= "src")+ <*> (obj .:? "test-directory" .!= "test")+ <*> (obj .:? "lib-directory" .!= "lib")+ <*> (obj .:? "resources-directory" .!= "resources")+ <*> (obj .:? "prefix-header" .!= "Prefix.pch")+ <*> (obj .:? "xcconfig" .!= "Config.xcconfig")+ <*> (Just <$> obj .:? "kitdeps-xcode-flags") .!= Nothing
Kit/Util.hs view
@@ -6,15 +6,17 @@ module Control.Monad, module System.Directory, module System.FilePath.Posix,- module Debug.Trace,+ module Control.Monad.Trans, Color(..), (>>>) ) where- import Debug.Trace+ import System.Directory import System.FilePath.Posix- import System.FilePath.Glob+ import System.FilePath.Glob (globDir1, compile) + import System.Posix.Env (getEnv)+ import Data.List import Data.Maybe import Data.Monoid@@ -23,7 +25,8 @@ import Control.Arrow import Control.Applicative import Control.Monad- import "mtl" Control.Monad.Error+ import Control.Monad.Error+ import Control.Monad.Trans import System.Cmd import System.Console.ANSI@@ -101,13 +104,24 @@ -> q (m b) (.=<<.) f = liftM join . T.mapM f++ isSet :: String -> IO Bool+ isSet = fmap isJust . getEnv say :: MonadIO m => Color -> String -> m () say color msg = do- liftIO $ setSGR [SetColor Foreground Vivid color]- puts msg- liftIO $ setSGR []+ colorize <- liftIO $ isSet "PS1"+ if colorize+ then do+ liftIO $ setSGR [SetColor Foreground Vivid color]+ puts msg+ liftIO $ setSGR []+ else+ puts msg - alert :: MonadIO m => String -> m ()- alert = say Red+ sayError :: MonadIO m => String -> m ()+ sayError = say Red++ sayWarn :: MonadIO m => String -> m ()+ sayWarn = say Yellow
Kit/Util/FSAction.hs view
@@ -34,3 +34,6 @@ mkdirP dir inDirectory dir $ runAction action +runActions :: [FSAction] -> IO ()+runActions = mapM_ runAction+
− Kit/Util/IsObject.hs
@@ -1,25 +0,0 @@-{-# LANGUAGE KindSignatures, TypeSynonymInstances, NoMonomorphismRestriction, OverlappingInstances #-}-module Kit.Util.IsObject where- import Data.Object-- class ShowObject x where- showObject :: x -> StringObject-- class ReadObject x where- readObject :: StringObject -> Maybe x- - (#>) :: ReadObject b => [(String, Object String String)] -> String -> Maybe b- obj #> key = lookupObject key obj >>= readObject-- instance ShowObject a => ShowObject [a] where- showObject xs = Sequence $ map showObject xs-- instance ReadObject a => ReadObject [a] where- readObject x = fromSequence x >>= mapM readObject -- instance ShowObject String where- showObject = Scalar-- instance ReadObject String where- readObject = fromScalar-
Kit/WorkingCopy.hs view
@@ -11,7 +11,6 @@ import Kit.Spec import qualified Data.List as L -import "mtl" Control.Monad.Trans import "mtl" Control.Monad.Error import qualified Data.ByteString as BS
Kit/Xcode/Builder.hs view
@@ -1,11 +1,12 @@-+{-# LANGUAGE PackageImports #-} module Kit.Xcode.Builder (renderXcodeProject) where import Kit.Xcode.Common import Kit.Xcode.ProjectFileTemplate import Text.PList+ import qualified Text.PList.PrettyPrint as PList (pp, ppFlat) import Kit.Util import Data.List (nub)- import Control.Monad.State+ import "mtl" Control.Monad.State createBuildFile :: Integer -> FilePath -> PBXBuildFile createBuildFile i path = PBXBuildFile uuid1 $ PBXFileReference uuid2 path@@ -26,7 +27,7 @@ headerBuildFiles <- mapM buildFileFromState headers sourceBuildFiles <- mapM buildFileFromState sources libBuildFiles <- mapM buildFileFromState libs -- Build File Items- let allBuildFiles = (sourceBuildFiles ++ headerBuildFiles ++ libBuildFiles)+ let allBuildFiles = sourceBuildFiles ++ headerBuildFiles ++ libBuildFiles -- Build And FileRef sections bfs = buildFileSection allBuildFiles frs = fileReferenceSection (map buildFileReference allBuildFiles) outputLibName @@ -39,7 +40,7 @@ frameworksPhase = frameworksBuildPhase libBuildFiles -- UUID indices libDirs = nub $ map dropFileName libs - return . show $ makeProjectPList (bfs ++ frs ++ [classes, headersPhase, srcsPhase, frameworksPhase, fg]) libDirs+ return . PList.ppFlat $ makeProjectPList (bfs ++ frs ++ [classes, headersPhase, srcsPhase, frameworksPhase, fg]) libDirs buildFileSection :: [PBXBuildFile] -> [PListObjectItem] buildFileSection bfs = map buildFileItem bfs ++ [@@ -109,5 +110,4 @@ "files" ~> arr (map (val . buildFileId) bfs), "runOnlyForDeploymentPostprocessing" ~> val "0" ]-
Kit/Xcode/ProjectFileTemplate.hs view
@@ -1,5 +1,14 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module Kit.Xcode.ProjectFileTemplate where+module Kit.Xcode.ProjectFileTemplate (+ makeProjectPList+ , kitConfigRefUUID + , productRefUUID+ , headersBuildPhaseUUID+ , frameworksBuildPhaseUUID+ , classesGroupUUID+ , frameworksGroupUUID+ , sourcesBuildPhaseUUID+ ) where import Kit.Xcode.Common import Text.PList@@ -8,19 +17,14 @@ import qualified Data.List as L -val_arr = arr . map val+makeProjectPList :: [PListObjectItem] -> [FilePath] -> PListFile +makeProjectPList objects libDirs = projectFile objs projectRootUUID where+ objs = objects ++ groups ++ projectRoot ++ buildConfigurations libDirs -projectFile objects rootId = PListFile "!$*UTF8*$!" $ obj [- "archiveVersion" ~> val "1",- "classes" ~> obj [],- "objectVersion" ~> val "46",- "objects" ~> obj objects, - "rootObject" ~> val rootId - ]+projectFile :: [PListObjectItem] -> String -> PListFile+projectFile objects rootId = plist "!$*UTF8*$!" rootId objects projectRootUUID = "0867D690FE84028FC02AAC07" -kitUpdateTargetUUID = "470E2D641287730A0084AE6F"-staticLibTargetUUID = "D2AAC07D0554694100DB518D" groupProductsUUID = "034768DFFF38A50411DB9C8B" mainGroupUUID = "0867D691FE84028FC02AAC07"@@ -38,9 +42,7 @@ projectBuildConfigurationsUUID = "1DEB922208733DC00010E9CD" staticLibBuildConfigurationsUUID = "1DEB921E08733DC00010E9CD" -makeProjectPList :: [PListObjectItem] -> [FilePath] -> PListFile -makeProjectPList objects libDirs = projectFile objs projectRootUUID where- objs = objects ++ groups ++ targets ++ buildConfigurations libDirs+val_arr = arr . map val groups = [ groupProductsUUID ~> group "Products" [ val productRefUUID ], mainGroupUUID ~> group "KitDeps" [@@ -62,10 +64,12 @@ "productRefGroup" ~> val groupProductsUUID, "projectDirPath" ~> val "", "projectRoot" ~> val "",- "targets" ~> val_arr [ staticLibTargetUUID, kitUpdateTargetUUID ] - ]]- -targets = (staticLibTargetUUID ~> obj [+ "targets" ~> arr [ val staticLibTargetUUID, kitUpdateTarget ] + ], staticLibTarget]++staticLibTargetUUID = "D2AAC07D0554694100DB518D"++staticLibTarget = staticLibTargetUUID ~> obj [ "isa" ~> val "PBXNativeTarget", "buildConfigurationList" ~> val staticLibBuildConfigurationsUUID, "buildPhases" ~> val_arr [ headersBuildPhaseUUID, sourcesBuildPhaseUUID, frameworksBuildPhaseUUID ],@@ -75,81 +79,79 @@ "productName" ~> val "KitDeps", "productReference" ~> val productRefUUID, "productType" ~> val "com.apple.product-type.library.static"- ]) : kitUpdateTarget ++ projectRoot+ ] librarySearchPaths libDirs = "LIBRARY_SEARCH_PATHS" ~> val ("$(inherited) " ++ join (L.intersperse " " libDirs)) -staticLibDebugConfigurationUUID = "1DEB921F08733DC00010E9CD"-staticLibReleaseConfigurationUUID = "1DEB922008733DC00010E9CD"--projectReleaseConfigurationUUID = "1DEB922408733DC00010E9CD"-projectDebugConfigurationUUID = "1DEB922308733DC00010E9CD" --buildConfiguration name baseConfig settings = obj $ [+buildConfiguration name baseConfig settings = tobj $ [ "isa" ~> val "XCBuildConfiguration",- "buildSettings" ~> obj settings, "name" ~> val name+ "buildSettings" ~> obj settings, + "name" ~> val name ] ++ (maybeToList baseConfig >>= (\c -> ["baseConfigurationReference" ~> val c])) buildConfigurations libDirs = let libSearch = librarySearchPaths libDirs in [ projectBuildConfigurationsUUID ~> obj [ "isa" ~> val "XCConfigurationList",- "buildConfigurations" ~> val_arr [projectDebugConfigurationUUID, projectReleaseConfigurationUUID],+ "buildConfigurations" ~> arr [buildConfiguration "Debug" (Just kitConfigRefUUID) [+ "GCC_C_LANGUAGE_STANDARD" ~> val "c99",+ "GCC_OPTIMIZATION_LEVEL" ~> val "0",+ "GCC_WARN_ABOUT_RETURN_TYPE" ~> val "YES",+ "GCC_WARN_UNUSED_VARIABLE" ~> val "YES",+ "OTHER_LDFLAGS" ~> val "-ObjC",+ "SDKROOT" ~> val "iphoneos",+ libSearch ]+ , buildConfiguration "Release" (Just kitConfigRefUUID) [+ "GCC_C_LANGUAGE_STANDARD" ~> val "c99",+ "GCC_WARN_ABOUT_RETURN_TYPE" ~> val "YES",+ "GCC_WARN_UNUSED_VARIABLE" ~> val "YES",+ "OTHER_LDFLAGS" ~> val "-ObjC",+ "SDKROOT" ~> val "iphoneos",+ libSearch+ ]], "defaultConfigurationIsVisible" ~> val "0", "defaultConfigurationName" ~> val "Release" ], staticLibBuildConfigurationsUUID ~> obj [ "isa" ~> val "XCConfigurationList",- "buildConfigurations" ~> val_arr [staticLibDebugConfigurationUUID, staticLibReleaseConfigurationUUID],+ "buildConfigurations" ~> arr [buildConfiguration "Debug" Nothing [+ "ALWAYS_SEARCH_USER_PATHS" ~> val "NO",+ "COPY_PHASE_STRIP" ~> val "NO",+ "DSTROOT" ~> val "/tmp/KitDeps.dst",+ "GCC_DYNAMIC_NO_PIC" ~> val "NO",+ "GCC_MODEL_TUNING" ~> val "G5",+ "GCC_OPTIMIZATION_LEVEL" ~> val "0",+ "GCC_PRECOMPILE_PREFIX_HEADER" ~> val "YES",+ "GCC_PREFIX_HEADER" ~> val "Prefix.pch",+ "INSTALL_PATH" ~> val "/usr/local/lib",+ "PRODUCT_NAME" ~> val "KitDeps",+ libSearch + ], buildConfiguration "Release" Nothing [+ "ALWAYS_SEARCH_USER_PATHS" ~> val "NO",+ "DSTROOT" ~> val "/tmp/KitDeps.dst",+ "GCC_MODEL_TUNING" ~> val "G5",+ "GCC_PRECOMPILE_PREFIX_HEADER" ~> val "YES",+ "GCC_PREFIX_HEADER" ~> val "Prefix.pch",+ "INSTALL_PATH" ~> val "/usr/local/lib",+ "PRODUCT_NAME" ~> val "KitDeps",+ libSearch+ ]], "defaultConfigurationIsVisible" ~> val "0", "defaultConfigurationName" ~> val "Release"- ],- projectDebugConfigurationUUID ~> buildConfiguration "Debug" (Just kitConfigRefUUID) [- "GCC_C_LANGUAGE_STANDARD" ~> val "c99",- "GCC_OPTIMIZATION_LEVEL" ~> val "0",- "GCC_WARN_ABOUT_RETURN_TYPE" ~> val "YES",- "GCC_WARN_UNUSED_VARIABLE" ~> val "YES",- "OTHER_LDFLAGS" ~> val "-ObjC",- "SDKROOT" ~> val "iphoneos",- libSearch- ],- projectReleaseConfigurationUUID ~> buildConfiguration "Release" (Just kitConfigRefUUID) [- "GCC_C_LANGUAGE_STANDARD" ~> val "c99",- "GCC_WARN_ABOUT_RETURN_TYPE" ~> val "YES",- "GCC_WARN_UNUSED_VARIABLE" ~> val "YES",- "OTHER_LDFLAGS" ~> val "-ObjC",- "SDKROOT" ~> val "iphoneos",- libSearch- ],- staticLibDebugConfigurationUUID ~> buildConfiguration "Debug" Nothing [- "ALWAYS_SEARCH_USER_PATHS" ~> val "NO",- "COPY_PHASE_STRIP" ~> val "NO",- "DSTROOT" ~> val "/tmp/KitDeps.dst",- "GCC_DYNAMIC_NO_PIC" ~> val "NO",- "GCC_MODEL_TUNING" ~> val "G5",- "GCC_OPTIMIZATION_LEVEL" ~> val "0",- "GCC_PRECOMPILE_PREFIX_HEADER" ~> val "YES",- "GCC_PREFIX_HEADER" ~> val "Prefix.pch",- "INSTALL_PATH" ~> val "/usr/local/lib",- "PRODUCT_NAME" ~> val "KitDeps",- libSearch - ],- staticLibReleaseConfigurationUUID ~> buildConfiguration "Release" Nothing [- "ALWAYS_SEARCH_USER_PATHS" ~> val "NO",- "DSTROOT" ~> val "/tmp/KitDeps.dst",- "GCC_MODEL_TUNING" ~> val "G5",- "GCC_PRECOMPILE_PREFIX_HEADER" ~> val "YES",- "GCC_PREFIX_HEADER" ~> val "Prefix.pch",- "INSTALL_PATH" ~> val "/usr/local/lib",- "PRODUCT_NAME" ~> val "KitDeps",- libSearch ] ] -kitUpdateTarget = [- kitUpdateTargetUUID ~> obj [ +kitUpdateTarget = tobj [ "isa" ~> val "PBXLegacyTarget", "buildArgumentsString" ~> val "",- "buildConfigurationList" ~> val "470E2D721287731E0084AE6F",+ "buildConfigurationList" ~> tobj [+ "isa" ~> val "XCConfigurationList",+ "buildConfigurations" ~> arr [ + buildConfiguration "Debug" Nothing [ "PRODUCT_NAME" ~> val "KitUpdate" ], + buildConfiguration "Release" Nothing ["PRODUCT_NAME" ~> val "KitUpdate" ]+ ],+ "defaultConfigurationIsVisible" ~> val "0",+ "defaultConfigurationName" ~> val "Debug"+ ], "buildPhases" ~> arr [], "buildToolPath" ~> val "/usr/bin/make", "buildWorkingDirectory" ~> val "",@@ -157,15 +159,6 @@ "name" ~> val "KitUpdate", "passBuildSettingsInEnvironment" ~> val "1", "productName" ~> val "KitUpdate"- ],- "470E2D721287731E0084AE6F" ~> obj [- "isa" ~> val "XCConfigurationList",- "buildConfigurations" ~> val_arr [ "470E2D651287730B0084AE6F", "470E2D661287730B0084AE6F" ],- "defaultConfigurationIsVisible" ~> val "0",- "defaultConfigurationName" ~> val "Debug"- ],- "470E2D651287730B0084AE6F" ~> buildConfiguration "Debug" Nothing [ "PRODUCT_NAME" ~> val "KitUpdate" ],- "470E2D661287730B0084AE6F" ~> buildConfiguration "Release" Nothing ["PRODUCT_NAME" ~> val "KitUpdate" ]- ]+ ]
Text/PList.hs view
@@ -1,51 +1,42 @@ {-# LANGUAGE TypeSynonymInstances #-}-module Text.PList where--import Data.List (isInfixOf, isPrefixOf, intersperse)-import Control.Monad+module Text.PList (+ PListType(..), + PListObjectItem(..),+ PListFile(..),+ val, + arr, + obj, + tobj,+ plist,+ (~>)) where -------------------------------------------------------------------------------+data PListFile = PListFile String String [PListObjectItem] -- Charset, root uuid, and the object to serialize+ -- | A Key/Value pair in a PList Object-data PListObjectItem = PListObjectItem {- itemKey :: String, -- The key in the object- itemValue :: PListType -- The value in the object- } deriving Eq +data PListObjectItem = PListObjectItem String PListType deriving Eq data PListType = PListValue String | PListArray [PListType]- | PListObject [PListObjectItem]+ | PListObject Bool [PListObjectItem] deriving Eq +plist :: String -> String -> [PListObjectItem] -> PListFile+plist a b c = PListFile a b c+ val :: String -> PListType+val = PListValue+ arr :: [PListType] -> PListType+arr = PListArray+ obj :: [PListObjectItem] -> PListType+obj = PListObject True -val = PListValue-arr = PListArray-obj = PListObject+tobj :: [PListObjectItem] -> PListType+tobj = PListObject False infixl 1 ~> (~>) :: String -> PListType -> PListObjectItem a ~> b = PListObjectItem a b--quote :: String -> String-quote s = "\"" ++ s ++ "\""--quotable :: String -> Bool-quotable "" = True-quotable s = any (\x -> x `isInfixOf` s && not ("sourcecode" `isPrefixOf` s)) quote_triggers- where quote_triggers = ["-", "<", ">", " ", ".m", ".h", "_", "$"]--instance Show PListObjectItem where- show (PListObjectItem k v) = k ++ " = " ++ show v ++ ";\n"--instance Show PListType where- show (PListValue a) = if quotable a then quote a else a - show (PListArray xs) = "(" ++ join (intersperse ", " $ map show xs) ++ ")"- show (PListObject kvs) = "{\n" ++ (kvs >>= (\x -> " " ++ show x)) ++ "}\n"--data PListFile = PListFile { pListFileCharset :: String, pListFileValue :: PListType }--instance Show PListFile where- show (PListFile charset value) = "// " ++ charset ++ "\n" ++ show value ++ "\n"
+ Text/PList/PrettyPrint.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE TupleSections, PackageImports #-}+module Text.PList.PrettyPrint (pp, ppFlat) where++import Data.List (intersperse, isInfixOf, isPrefixOf)+import Control.Monad (join, (>=>), forM)+import Text.PList++import Kit.Xcode.Common++import "mtl" Control.Monad.Writer (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"++printItem :: PListObjectItem -> [Char]+printItem (PListObjectItem k v) = k ++ " = " ++ printValue v ++ ";\n"++printValue :: PListType -> [Char]+printValue (PListValue a) = if quotable a then quote a else a +printValue (PListArray xs) = "(" ++ join (intersperse ", " $ map printValue xs) ++ ")"+printValue (PListObject _ kvs) = "{\n" ++ (kvs >>= (\x -> " " ++ printItem x)) ++ "}\n"++quote :: String -> String+quote s = "\"" ++ s ++ "\""++quotable :: String -> Bool+quotable "" = True+quotable s = any (\x -> x `isInfixOf` s && not ("sourcecode" `isPrefixOf` s)) quote_triggers+ where quote_triggers = ["-", "<", ">", " ", ".m", ".h", "_", "$"]++-----++ppFlat :: PListFile -> String+ppFlat (PListFile charset root objects) = "// " ++ charset ++ "\n" ++ printFlat doc ++ "\n"+ where doc = [ ("archiveVersion", FlatStr "1"),+ ("classes", FlatObj []),+ ("objectVersion", FlatStr "46"),+ -- All Nested objects must end up within "objects", so that is where the flattening happens+ ("objects" , FlatObj (flatten' objects seedKeys)), + ("rootObject", FlatStr root)+ ]++seedKeys = map uuid [50000..]++printFlat :: FlatDocument -> String+printFlat = printFlatItem . FlatObj++quoteIf a = if quotable a then quote a else a++xxx (k,v) = k ++ " = " ++ printFlatItem v ++ ";\n"++printFlatItem (FlatStr a) = quoteIf a+printFlatItem (FlatArr xs) = "(" ++ join (intersperse ", " $ map quoteIf xs) ++ ")"+printFlatItem (FlatObj kvs) = "{\n" ++ (kvs >>= (\x -> " " ++ xxx x)) ++ "}\n"++-- A nested PList document+type Document = [PListObjectItem]++-- A flat flattened document, any internal object/arrays have been referenced and promoted to the top level object+type FlatDocument = [(String, FlatItem)]+data FlatItem = FlatStr String | FlatArr [String] | FlatObj [(String, FlatItem)] deriving (Eq, Show)++flatten' :: Document -> [String] -> FlatDocument+flatten' doc refs = let (a,b) = runWriter $ fmap fst $ runStateT (expandDoc doc) refs+ in a ++ b++expandDoc :: Document -> ObjectWriter [(String, FlatItem)]+expandDoc doc = forM doc $ \(PListObjectItem key item) -> do+ flat <- expand item+ return (key, flat) ++type ObjectWriter a = StateT [String] (Writer [(String, FlatItem)]) a++expand :: PListType -> ObjectWriter FlatItem+expand (PListValue s) = return $ FlatStr s+expand (PListArray xs) = fmap FlatArr $ mapM (expand >=> arrExpandFlat) xs+expand (PListObject embed contents) =+ let writeMethod = if embed+ then return + else fmap FlatStr . writeObj + flatContents = mapM (\(PListObjectItem a b) -> fmap (a,) (expand b)) contents+ in writeMethod . FlatObj =<< flatContents++arrExpandFlat :: FlatItem -> ObjectWriter String+arrExpandFlat (FlatStr s) = return s+arrExpandFlat x@(FlatArr _) = writeObj x+arrExpandFlat o@(FlatObj _) = writeObj o++readRef :: ObjectWriter String+readRef = do+ (x:xs) <- get+ put xs+ return x++writeToRef ref obj = tell [(ref, obj)]++writeObj o = do+ r <- readRef+ writeToRef r o+ return r+
kit.cabal view
@@ -1,5 +1,5 @@ name: kit-version: 0.7.8+version: 0.7.9 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -16,26 +16,28 @@ buildable: True build-depends: base >=3 && <5, Glob >= 0.5.1 && < 6, - HTTP >=4000.0.9, + attoparsec,+ HTTP, ansi-terminal >= 0.5.5, bytestring -any, - cabal-file-th >= 0.1,+ cabal-file-th >= 0.2.2, cmdargs >= 0.6.2, containers -any, - data-object -any, - data-object-yaml -any,+ yaml, directory -any, filepath -any, - mtl >= 2.0 && < 3, + mtl -any, network -any, process -any, template-haskell,- unix >= 2.4 && < 2.5+ unordered-containers,+ text,+ 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- Kit.Contents Kit.Commands Kit.CmdArgs Kit.Util.IsObject Kit.Util.FSAction Kit.WorkingCopy+ 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.Dependency Ghc-options: -Wall