diff --git a/Kit/Commands.hs b/Kit/Commands.hs --- a/Kit/Commands.hs +++ b/Kit/Commands.hs @@ -45,5 +45,5 @@ defaultLocalRepoPath = getHomeDirectory >>= \h -> return $ h ".kit" "repository" defaultLocalRepository :: IO KitRepository -defaultLocalRepository = fileRepo <$> defaultLocalRepoPath +defaultLocalRepository = KitRepository <$> defaultLocalRepoPath diff --git a/Kit/Project.hs b/Kit/Project.hs --- a/Kit/Project.hs +++ b/Kit/Project.hs @@ -19,6 +19,7 @@ import Data.List import Data.Tree import System.Cmd +import System.Posix.Files import qualified Data.ByteString as BS @@ -54,6 +55,7 @@ createHeader kitsContents createConfig kitsContents specs writeFile depsConfigFile $ "#include \"" ++ xcodeConfigFile ++ "\"\n" ++ fromMaybe "" depsOnlyConfig + symlinkAll specs where sourceDirs specs = specs >>= (\spec -> [ kitDir packageFileName spec specSourceDirectory spec, packageFileName spec specSourceDirectory spec @@ -76,6 +78,21 @@ writeFile xcodeConfigFile $ kitHeaders ++ "\n" ++ prefixHeaders ++ "\n" ++ configToString combinedConfig ++ "\n" writeFile kitUpdateMakeFilePath kitUpdateMakeFile +symlinkAll :: [KitSpec] -> IO () +symlinkAll specs = do + mkdirP "Resources" + mapM_ symlinkResources specs + +symlinkResources :: KitSpec -> IO () +symlinkResources spec = let when' a b = a >>= flip when b in do + let resourcesDir = packageFileName spec specResourcesDirectory spec + let linkName = "Resources" packageName spec + when' (fileExist linkName) $ do + removeLink linkName + when' (doesDirectoryExist resourcesDir) $ do + puts $ "-> Linking resources in " ++ resourcesDir + 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 @@ -86,14 +103,14 @@ -- todo: check for version ranges :) unfoldDeps :: KitRepository -> KitSpec -> KitIO (Kit, [KitSpec]) -unfoldDeps kr ks = (specKit ks,) <$> mapM (getKitSpec kr) (specDependencies ks) -- s/mapM/traverse ? +unfoldDeps kr ks = (specKit ks,) <$> mapM (readKitSpec kr) (specDependencies ks) -- s/mapM/traverse ? installKit :: KitRepository -> Kit -> IO () installKit kr kit = do tmpDir <- getTemporaryDirectory let fp = tmpDir (packageFileName kit ++ ".tar.gz") putStrLn $ " -> Installing " ++ packageFileName kit - fmap fromJust $ getKit kr kit fp + extractKit kr kit fp mkdirP kitDir inDirectory kitDir $ system ("tar zxf " ++ fp) return () diff --git a/Kit/Repository.hs b/Kit/Repository.hs --- a/Kit/Repository.hs +++ b/Kit/Repository.hs @@ -1,72 +1,38 @@ module Kit.Repository ( - getKit, - getKitSpec, - webRepo, - fileRepo, - KitRepository + extractKit, + readKitSpec, + KitRepository(KitRepository) ) where import Kit.Spec import Kit.Util - import Network.BufferType - import Network.HTTP - import Network.URI import Control.Monad.Error - import Data.Maybe import qualified Data.List as L import qualified Data.Traversable as T import qualified Data.ByteString as BS - data KitRepository = KitRepository { - repoSave :: String -> FilePath -> IO (Maybe ()), - repoRead :: String -> IO (Maybe BS.ByteString) - } - - getKit :: KitRepository -> Kit -> FilePath -> IO (Maybe ()) - getKit kr k = repoSave kr (kitPackagePath k) + data KitRepository = KitRepository { repositoryBase :: FilePath } deriving (Eq, Show) - getKitSpec :: KitRepository -> Kit -> KitIO KitSpec - getKitSpec kr k = do - mbKitStuff <- liftIO $ repoRead kr (kitSpecPath k) - maybe (throwError $ "Missing " ++ packageFileName k) f mbKitStuff - where f contents = maybeToKitIO ("Invalid KitSpec file for " ++ packageFileName k) $ decodeSpec contents + extractKit :: KitRepository -> Kit -> FilePath -> IO () + extractKit repo kit destPath = copyFile (repositoryBase repo kitPackagePath kit) destPath - -- TODO: Use the base url! - webRepo :: String -> KitRepository - webRepo _ = KitRepository save doRead where - save = download - doRead = getBody + readKitSpec :: KitRepository -> Kit -> KitIO KitSpec + readKitSpec repo kit = do + mbKitStuff <- liftIO $ doRead repo (kitSpecPath kit) + maybe (throwError $ "Missing " ++ packageFileName kit) f mbKitStuff + where f contents = maybeToKitIO ("Invalid KitSpec file for " ++ packageFileName kit) $ decodeSpec contents - fileRepo :: String -> KitRepository - fileRepo baseDir = KitRepository save doRead where - save src destPath = Just <$> copyFile (baseDir src) destPath - doRead fp = let file = (baseDir fp) in do - exists <- doesFileExist file - T.sequenceA $ justTrue exists $ BS.readFile file + 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 - -- private! baseKitPath :: Kit -> String baseKitPath k = joinS ["kits", kitName k, kitVersion k] "/" where joinS xs x = foldl1 (++) $ L.intersperse x xs kitPackagePath, kitSpecPath :: Kit -> String - kitPackagePath k = baseKitPath k ++ "/" ++ packageFileName k ++ ".tar.gz" kitSpecPath k = baseKitPath k ++ "/" ++ "KitSpec" - - getBody :: BufferType a => HStream a => String -> IO (Maybe a) - getBody p = let - request = defaultGETRequest_ . fromJust . parseURI - leftMaybe = either (const Nothing) Just - in do - rr <- Network.HTTP.simpleHTTP $ request p - return $ fmap rspBody $ leftMaybe rr - - download :: String -> FilePath -> IO (Maybe ()) - download url destination = do - body <- getBody url - T.sequenceA $ fmap (BS.writeFile destination) body - - diff --git a/Kit/Spec.hs b/Kit/Spec.hs --- a/Kit/Spec.hs +++ b/Kit/Spec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE KindSignatures, TypeSynonymInstances, NoMonomorphismRestriction, OverlappingInstances #-} module Kit.Spec ( -- | The Core Kit types KitSpec(..), @@ -19,6 +18,7 @@ import Control.Monad.Trans import Data.Object + import Kit.Util.IsObject import qualified Data.ByteString as BS import qualified Data.Object.Yaml as Y @@ -28,6 +28,7 @@ specSourceDirectory :: FilePath, specTestDirectory :: FilePath, specLibDirectory :: FilePath, + specResourcesDirectory :: FilePath, specPrefixFile :: FilePath, specConfigFile :: FilePath, specKitDepsXcodeFlags :: Maybe String @@ -57,7 +58,7 @@ packageVersion = kitVersion . specKit defaultSpec :: String -> String -> KitSpec - defaultSpec name version = KitSpec (Kit name version) [] "src" "test" "lib" "Prefix.pch" "Config.xcconfig" Nothing + defaultSpec name version = KitSpec (Kit name version) [] "src" "test" "lib" "resources" "Prefix.pch" "Config.xcconfig" 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. @@ -72,25 +73,8 @@ writeSpec :: MonadIO m => FilePath -> KitSpec -> m () writeSpec fp spec = liftIO $ BS.writeFile fp $ encodeSpec spec - class IsObject x where - showObject :: x -> StringObject - readObject :: StringObject -> Maybe x - - - (#>) :: IsObject b => [(String, Object String String)] -> String -> Maybe b - obj #> key = lookupObject key obj >>= readObject - - instance IsObject a => IsObject [a] where - showObject xs = Sequence $ map showObject xs - readObject x = fromSequence x >>= mapM readObject - - instance IsObject String where - showObject = Scalar - readObject = fromScalar - 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" instance IsObject KitSpec where @@ -108,6 +92,7 @@ <*> (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 diff --git a/Kit/Util/IsObject.hs b/Kit/Util/IsObject.hs new file mode 100644 --- /dev/null +++ b/Kit/Util/IsObject.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE KindSignatures, TypeSynonymInstances, NoMonomorphismRestriction, OverlappingInstances #-} +module Kit.Util.IsObject where + import Data.Object + + class IsObject x where + showObject :: x -> StringObject + readObject :: StringObject -> Maybe x + + (#>) :: IsObject b => [(String, Object String String)] -> String -> Maybe b + obj #> key = lookupObject key obj >>= readObject + + instance IsObject a => IsObject [a] where + showObject xs = Sequence $ map showObject xs + readObject x = fromSequence x >>= mapM readObject + + instance IsObject String where + showObject = Scalar + readObject = fromScalar + diff --git a/Kit/Xcode/Common.hs b/Kit/Xcode/Common.hs --- a/Kit/Xcode/Common.hs +++ b/Kit/Xcode/Common.hs @@ -10,9 +10,9 @@ fileType :: String -> String fileType x | ".h" `isSuffixOf` x = "sourcecode.c.h" -fileType x | ".m" `isSuffixOf` x = "sourcecode.c.obj" -fileType x | ".mm" `isSuffixOf` x = "sourcecode.c.obj" -fileType x | ".c" `isSuffixOf` x = "sourcecode.c.obj" +fileType x | ".m" `isSuffixOf` x = "sourcecode.c.objc" +fileType x | ".mm" `isSuffixOf` x = "sourcecode.c.objc" +fileType x | ".c" `isSuffixOf` x = "sourcecode.c.objc" fileType x | ".a" `isSuffixOf` x = "archive.ar" fileType x | ".framework" `isSuffixOf` x = "wrapper.framework" fileType x | ".xcconfig" `isSuffixOf` x = "text.xcconfig" diff --git a/kit.cabal b/kit.cabal --- a/kit.cabal +++ b/kit.cabal @@ -1,5 +1,5 @@ name: kit -version: 0.6.2 +version: 0.6.3 cabal-version: >=1.2 build-type: Simple license: BSD3 @@ -17,10 +17,11 @@ build-depends: process -any, network -any, mtl -any, filepath -any, directory -any, containers -any, cmdargs >=0.3, bytestring -any, base >=3 && <5, - HTTP >=4000.0.9, Glob >= 0.5, data-object -any, data-object-yaml -any + HTTP >=4000.0.9, Glob >= 0.5, data-object -any, data-object-yaml -any, + unix >= 2.4 && < 2.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.Contents Kit.Commands Kit.CmdArgs Kit.Util.IsObject Ghc-options: -Wall -fno-warn-unused-do-bind