- 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 (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 (Languages _) langs = Languages $ M.fromList $ unmarshalStringPairs langs
-
-
-{- getting default value -}
-sysConfDefault :: SystemConfig -> SysConfValue -> IO SysConfValue
-
-sysConfDefault _ (SiteName _)
- = return $ SiteName "Rakka"
-
-sysConfDefault sc (BaseURI _)
- = do let conf = scLucuConf sc
- host = C8.unpack $ LC.cnfServerHost conf
- port = case LC.cnfServerPort conf of
- PortNumber num -> fromIntegral num
-
- defaultURI
+ deserializePair' ∷ Text → Maybe (Text, Text)
+ deserializePair' s = case T.breakOn " " s of
+ (a, b)
+ | (¬) (T.null b) → Just (a, T.tail b)
+ _ → Nothing
+
+deserializeMap ∷ Ord k ⇒ (Text → k) → (Text → v) → Text → Maybe (Map k v)
+deserializeMap f g = (M.fromList ∘ ((f ⁂ g) <$>) <$>) ∘ deserializeTextPairs
+
+newtype SiteName = SiteName Text deriving (Show, Typeable, Eq)
+instance SysConfValue SiteName where
+ confPath _ = "siteName"
+ serialize (SiteName name) = name
+ deserialize = Just . SiteName
+ defaultValue _ = SiteName "Rakka"
+
+newtype BaseURI = BaseURI URI deriving (Show, Typeable, Eq)
+instance SysConfValue BaseURI where
+ confPath _ = "baseURI"
+ serialize (BaseURI uri) = T.pack $ uriToString id uri ""
+ deserialize uri = fmap BaseURI
+ $ do parsed ← parseURI (T.unpack uri)
+ when (uriPath parsed ≡ "" ) mzero
+ when (last (uriPath parsed) ≠ '/') mzero
+ when (uriQuery parsed ≠ "" ) mzero
+ when (uriFragment parsed ≠ "" ) mzero
+ return parsed
+ defaultValue sc
+ = let conf = scLucuConf sc
+ host = C8.unpack $ LC.cnfServerHost conf
+ port = unsafePerformIO $
+ do ent <- getServiceByName (LC.cnfServerPort conf) "tcp"
+ return (servicePort ent)
+ -- FIXME: There should be a way to change configurations
+ -- without web interface nor direct repository
+ -- modification.
+ defaultURI