Record before an experiment

[Rakka.git] / Rakka / SystemConfig.hs

diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs
index 58de2bec0ca22afb68ce1534dc23691617136cd1..966ecf10d6c6ca1c2e4dc1af5a7d02279b9dfd9e 100644 (file)
--- 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"  )
+                   ]
+