Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

optional new configuration line {"scion-default-cabal-config":"dist-s…

…cion"}

telling scion which configuration to load
  • Loading branch information...
commit 741fc1f5f4bb33e367d6269bb41850af085f2514 1 parent d2f8dfa
@MarcWeber MarcWeber authored
View
13 lib/Scion/Session.hs
@@ -28,7 +28,7 @@ import Control.Monad
import Data.Data
import Data.IORef
import Data.List ( intercalate, nubBy )
-import Data.Maybe ( isJust, fromMaybe )
+import Data.Maybe ( isJust, fromMaybe, fromJust )
import Data.Monoid
import Data.Time.Clock ( getCurrentTime, diffUTCTime )
import System.Directory ( setCurrentDirectory, getCurrentDirectory,
@@ -214,8 +214,9 @@ cabalProjectComponents cabal_file = do
-- uniq: both, but prefer config items
cabalConfigurations :: FilePath -- ^ The .cabal file
-> String -- ^ one of "dist" "config" "all"
+ -> Bool -- only show scion default?
-> ScionM [CabalConfiguration]
-cabalConfigurations cabal type' = do
+cabalConfigurations cabal type' scionDefaultOnly = do
let allowed = ["dist", "config", "all", "uniq"]
when (not $ elem type' allowed) $ scionError $ "invalid value for type, expected: one of " ++ (show allowed)
let dir = takeDirectory cabal
@@ -226,7 +227,13 @@ cabalConfigurations cabal type' = do
-- TODO read flags from setup-config files
++ (if type' `elem` ["all", "dist", "uniq"] then map (\ a-> CabalConfiguration a []) existingDists else [])
let f = if type' == "uniq" then nubBy (\a b -> distDir a == distDir b) else id
- return $ f list
+ -- apply filter
+ let list' = f list
+ let d = scionDefaultCabalConfig config
+ let scionDefault = filter ( ((fromJust d) ==) . distDir) list'
+ return $ if isJust d && scionDefaultOnly && (not . null) scionDefault
+ then scionDefault
+ else list'
-- | Run the steps that Cabal would call before building.
--
View
5 lib/Scion/Types.hs
@@ -319,7 +319,8 @@ type FileComponentConfiguration =
-- helperf functions see Utils.hs
data ScionProjectConfig = ScionProjectConfig {
buildConfigurations :: [CabalConfiguration],
- fileComponentExtraFlags :: [FileComponentConfiguration]
+ fileComponentExtraFlags :: [FileComponentConfiguration],
+ scionDefaultCabalConfig :: Maybe String
}
emptyScionProjectConfig :: ScionProjectConfig
-emptyScionProjectConfig = ScionProjectConfig [] []
+emptyScionProjectConfig = ScionProjectConfig [] [] Nothing
View
20 lib/Scion/Utils.hs
@@ -112,6 +112,15 @@ instance JSON CabalConfiguration where
("dist-dir", JSString (toJSString dd))
, ("extra-args", JSArray (map (JSString . toJSString) ea)) ]
+
+data ScionDefaultCabalConfig = ScionDefaultCabalConfig String
+instance JSON ScionDefaultCabalConfig where
+ readJSON (JSObject obj)
+ | Ok s <- lookupKey obj "scion-default-cabal-config"
+ = return $ ScionDefaultCabalConfig s
+ readJSON _ = fail "ScionDefaultCabalConfig"
+ showJSON (ScionDefaultCabalConfig s) = makeObject $ [ ("scion-default-cabal-config", (JSString . toJSString) s) ]
+
readFileComponentConfig :: JSValue -> Result (String, [String])
readFileComponentConfig (JSObject obj)
@@ -137,8 +146,10 @@ writeSampleConfig file = do
"// this is a demo scion project configuration file has been created for you"
,"// you can use it to write down a set of configurations you'd like to test"
,"//"
+ ,"// make scion select the default scion entry"
+ ,"{\"scion-default-cabal-config\":\"dist-scion\"}"
,"// default scion entry:"
- ,"{\"type\":\"build-configuration\", \"dist-dir\":\"dist-scion\", \"extra-args\": []}"
+ ,"{\"type\":\"build-configuration\", \"dist-dir\":\"dist-scion\", \"extra-args\": [], \"scion-default\": 1}"
,"//"
,"// some examples:"
,"{\"type\":\"build-configuration\", \"dist-dir\":\"dist-demo-simple-tools-from-path-default\", \"extra-args\": []}"
@@ -171,5 +182,8 @@ parseScionProjectConfig path = do
parseJSON pc json = case readJSON json of
Ok bc -> return $ pc { buildConfigurations = bc : buildConfigurations pc }
Error msg1 -> case readFileComponentConfig json of
- Ok cf -> return $ pc { fileComponentExtraFlags = cf : fileComponentExtraFlags pc }
- Error msg2 -> scionError $ "invalid JSON object " ++ (show json) ++ " error :" ++ msg1 ++ "\n" ++ msg2
+ Ok cf -> return $ pc { fileComponentExtraFlags = cf : fileComponentExtraFlags pc }
+ Error msg2 -> case readJSON json of
+ Ok (ScionDefaultCabalConfig name) -> return $ pc { scionDefaultCabalConfig = Just name }
+ Error msg3 -> scionError $ "invalid JSON object " ++ (show json) ++ " error :" ++ msg1 ++ "\n" ++ msg2 ++ "\n" ++ msg3
+
View
9 server/Scion/Server/Commands.hs
@@ -290,6 +290,10 @@ cmdConfigureCabalProject =
preprocessPackage rel_dist
(toJSString . display . PD.package) `fmap` currentCabalPackage
+decodeBool :: JSValue -> Bool
+decodeBool (JSBool b) = b
+decodeBool _ = error "no bool"
+
decodeExtraArgs :: JSValue -> [String]
decodeExtraArgs JSNull = []
decodeExtraArgs (JSString s) =
@@ -439,8 +443,9 @@ cmdListCabalConfigurations :: Cmd
cmdListCabalConfigurations =
Cmd "list-cabal-configurations" $
reqArg' "cabal-file" fromJSString <&>
- optArg' "type" "uniq" fromJSString $ cmd
- where cmd cabal_file type' = liftM showJSON $ cabalConfigurations cabal_file type'
+ optArg' "type" "uniq" id <&>
+ optArg' "scion-default" False decodeBool $ cmd
+ where cmd cabal_file type' scionDefault = liftM showJSON $ cabalConfigurations cabal_file type' scionDefault
cmdWriteSampleConfig :: Cmd
cmdWriteSampleConfig =
Please sign in to comment.
Something went wrong with that request. Please try again.