Exodus to GHC 6.8.1

[Rakka.git] / Rakka / SystemConfig.hs

diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs
index 09c45166530dfc4b5f53fe700ff6aeec0aa0543f..10b39b354fa5ba1ae986befc19f2f22ca02bfa3d 100644 (file)
--- a/Rakka/SystemConfig.hs
+++ b/Rakka/SystemConfig.hs
@@ -15,13 +15,14 @@ module Rakka.SystemConfig
     )
     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 +30,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 +40,8 @@ import           Subversion.Repository
 import           System.FilePath.Posix
 import           System.Log.Logger
 
+
+logger :: String
 logger = "Rakka.SystemConfig"
 
 
@@ -91,7 +94,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
 
@@ -148,13 +151,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