X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FSystemConfig.hs;fp=Rakka%2FSystemConfig.hs;h=966ecf10d6c6ca1c2e4dc1af5a7d02279b9dfd9e;hb=f4a655a34bc6017db008c2e915053958ae13ee81;hp=58de2bec0ca22afb68ce1534dc23691617136cd1;hpb=ace1b98b247b32e719a72a04fafe9fbffc1c49b0;p=Rakka.git diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs index 58de2be..966ecf1 100644 --- a/Rakka/SystemConfig.hs +++ b/Rakka/SystemConfig.hs @@ -21,7 +21,9 @@ import Data.Maybe import GHC.Conc (unsafeIOToSTM) import Network import qualified Network.HTTP.Lucu.Config as LC +import Network.HTTP.Lucu.Utils import Network.URI +import Rakka.Page import Rakka.Utils import Subversion.FileSystem import Subversion.FileSystem.Revision @@ -45,6 +47,7 @@ data SysConfValue | BaseURI URI | DefaultPage String | StyleSheet String + | Languages (Map LanguageTag LanguageName) deriving (Eq, Show) @@ -107,28 +110,47 @@ fromConfPath :: FilePath -> FilePath fromConfPath = combine "/config" +marshalStringPairs :: [(String, String)] -> String +marshalStringPairs = joinWith "\n" . map marshalPair' + where + marshalPair' :: (String, String) -> String + marshalPair' (a, b) = a ++ " " ++ b + + +unmarshalStringPairs :: String -> [(String, String)] +unmarshalStringPairs = catMaybes . map unmarshalPair' . lines + where + unmarshalPair' :: String -> Maybe (String, String) + unmarshalPair' s = case break (/= ' ') s of + (a, ' ':b) -> Just (a, b) + _ -> Nothing + + {- paths -} sysConfPath :: SysConfValue -> FilePath sysConfPath (SiteName _) = "siteName" sysConfPath (BaseURI _) = "baseURI" sysConfPath (DefaultPage _) = "defaultPage" sysConfPath (StyleSheet _) = "styleSheet" +sysConfPath (Languages _) = "languages" {- marshalling -} marshalSysConf :: SysConfValue -> String -marshalSysConf (SiteName name) = name -marshalSysConf (BaseURI uri ) = uriToString id uri "" -marshalSysConf (DefaultPage name) = name -marshalSysConf (StyleSheet name) = name +marshalSysConf (SiteName name ) = name +marshalSysConf (BaseURI uri ) = uriToString id uri "" +marshalSysConf (DefaultPage name ) = name +marshalSysConf (StyleSheet name ) = name +marshalSysConf (Languages langs) = marshalStringPairs (M.toList langs) {- unmarshalling -} unmarshalSysConf :: SysConfValue -> String -> SysConfValue -unmarshalSysConf (SiteName _) name = SiteName name -unmarshalSysConf (BaseURI _) uri = BaseURI $ fromJust $ parseURI uri -unmarshalSysConf (DefaultPage _) name = DefaultPage name -unmarshalSysConf (StyleSheet _) name = StyleSheet name +unmarshalSysConf (SiteName _) name = SiteName name +unmarshalSysConf (BaseURI _) uri = BaseURI $ fromJust $ parseURI uri +unmarshalSysConf (DefaultPage _) name = DefaultPage name +unmarshalSysConf (StyleSheet _) name = StyleSheet name +unmarshalSysConf (Languages _) langs = Languages $ M.fromList $ unmarshalStringPairs langs {- getting default value -} @@ -156,3 +178,19 @@ sysConfDefault _ (DefaultPage _) sysConfDefault _ (StyleSheet _) = return $ StyleSheet "StyleSheet/Default" + +sysConfDefault _ (Languages _) + = return + $ Languages + $ M.fromList [ ("en", "English" ) + , ("es", "Español" ) + , ("de", "Deutsch" ) + , ("fi", "Suomi" ) + , ("fr", "Français" ) + , ("ga", "Gaeilge" ) + , ("gd", "Gàidhlig" ) + , ("ja", "日本語" ) + , ("pt", "Português") + , ("sv", "Svenska" ) + ] +