implemented language link editor (partly)

[Rakka.git] / Rakka / SystemConfig.hs

diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs
index de33f911119eb07aac46ab6dc04cd52cb163bb0a..ecf608df873232944880dbc0b518d6644cbebf46 100644 (file)
--- a/Rakka/SystemConfig.hs
+++ b/Rakka/SystemConfig.hs
@@ -12,16 +12,21 @@ module Rakka.SystemConfig
     , DefaultPage(..)
     , StyleSheet(..)
     , Languages(..)
+    , GlobalLock(..)
+
+    , serializeStringPairs
+    , deserializeStringPairs
     )
     where
 
+import           Codec.Binary.UTF8.String
 import           Control.Arrow.ArrowIO
 import           Control.Concurrent.STM
+import           Control.Monad
 import           Control.Monad.Trans
 import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy  as L
 import           Data.Dynamic
-import           Data.Encoding
-import           Data.Encoding.UTF8
 import           Data.Map (Map)
 import qualified Data.Map as M
 import           Data.Maybe
@@ -29,7 +34,7 @@ import           GHC.Conc (unsafeIOToSTM)
 import           Network
 import qualified Network.HTTP.Lucu.Config as LC
 import           Network.HTTP.Lucu.Utils
-import           Network.URI
+import           Network.URI hiding (path)
 import           Rakka.Page
 import           Rakka.Utils
 import           Subversion.FileSystem
@@ -39,6 +44,8 @@ import           Subversion.Repository
 import           System.FilePath.Posix
 import           System.Log.Logger
 
+
+logger :: String
 logger = "Rakka.SystemConfig"
 
 
@@ -91,7 +98,7 @@ getSysConf' sc
                        case exists of
                          True
                              -> do str <- getFileContentsLBS path
-                                   return $ Just $ chomp $ decodeLazy UTF8 str
+                                   return $ Just $ chomp $ decode $ L.unpack str
                          False
                              -> return Nothing
 
@@ -114,7 +121,7 @@ getSysConfA = arrIO0 . getSysConf
 
 
 fromConfPath :: FilePath -> FilePath
-fromConfPath = combine "/config"
+fromConfPath = ("/config" </>)
 
 
 serializeStringPairs :: [(String, String)] -> String
@@ -128,7 +135,7 @@ deserializeStringPairs :: String -> Maybe [(String, String)]
 deserializeStringPairs = sequence . map deserializePair' . lines
     where
       deserializePair' :: String -> Maybe (String, String)
-      deserializePair' s = case break (/= ' ') s of
+      deserializePair' s = case break (== ' ') s of
                              (a, ' ':b) -> Just (a, b)
                              _          -> Nothing
 
@@ -148,13 +155,19 @@ newtype BaseURI = BaseURI URI deriving (Show, Typeable)
 instance SysConfValue BaseURI where
     confPath _              = "baseURI"
     serialize (BaseURI uri) = uriToString id uri ""
-    deserialize uri         = fmap BaseURI (parseURI uri)
+    deserialize uri         = fmap BaseURI
+                              $ do parsed <- parseURI uri
+                                   when (uriPath parsed        == "" ) (fail undefined)
+                                   when (last (uriPath parsed) /= '/') (fail undefined)
+                                   when (uriQuery parsed       /= "" ) (fail undefined)
+                                   when (uriFragment parsed    /= "" ) (fail undefined)
+                                   return parsed
     defaultValue sc
         = let conf = scLucuConf sc
               host = C8.unpack $ LC.cnfServerHost conf
               port = case LC.cnfServerPort conf of
-                       PortNumber num -> fromIntegral num
-
+                       PortNumber num -> fromIntegral num :: Int
+                       _              -> undefined
               defaultURI
                   = "http://" ++ host ++ -- FIXME: consider IPv6 address
                     (if port == 80
@@ -197,3 +210,15 @@ instance SysConfValue Languages where
                                  , ("pt", "Português")
                                  , ("sv", "Svenska"  )
                                  ]
+
+
+newtype GlobalLock = GlobalLock Bool deriving (Show, Typeable)
+instance SysConfValue GlobalLock where
+    confPath _      = "globalLock"
+    serialize (GlobalLock isLocked)
+        | isLocked  = "*"
+        | otherwise = ""
+    deserialize "*" = Just (GlobalLock True)
+    deserialize ""  = Just (GlobalLock False)
+    deserialize _   = Nothing
+    defaultValue _  = GlobalLock False