DisplayAble vs Show for Theme completed.
This commit is contained in:
parent
8b46a690a8
commit
5cc3920059
@ -65,10 +65,10 @@ getProfileR = do
|
||||
[ (MsgName , userDisplayName )
|
||||
, (MsgIdent , userIdent )
|
||||
, (MsgPlugin , userPlugin )
|
||||
, (MsgMatrikelNr , fromMaybe "" userMatrikelnummer)
|
||||
, (MsgMatrikelNr , display userMatrikelnummer)
|
||||
, (MsgEMail , userEmail )
|
||||
, (MsgFavoriten , pack $ show userMaxFavourites)
|
||||
, (MsgTheme , pack $ show userTheme )
|
||||
, (MsgFavoriten , display userMaxFavourites)
|
||||
, (MsgTheme , display userTheme )
|
||||
]
|
||||
userDisplay = mconcat
|
||||
[ headless $ toWgt . mr . fst
|
||||
|
||||
@ -197,7 +197,8 @@ data Theme --Simply add Themes to this type only. CamelCase will be conver
|
||||
| SkyLove
|
||||
deriving (Eq,Ord,Bounded,Enum)
|
||||
|
||||
$(deriveShowWith uncamel ''Theme)
|
||||
$(deriveShowWith uncamel ''Theme) -- show for internal use in css/js
|
||||
$(deriveSimpleWith ''DisplayAble 'display camelSpace ''Theme) -- display to display at user
|
||||
|
||||
allThemes :: [Theme]
|
||||
allThemes = [minBound..maxBound]
|
||||
|
||||
12
src/Utils.hs
12
src/Utils.hs
@ -71,15 +71,23 @@ withFragment :: ( Monad m
|
||||
withFragment form html = (flip fmap) form $ \(x, widget) -> (x, toWidget html >> widget)
|
||||
|
||||
|
||||
uncamel :: String -> String -- "Model.Theme.CamelCaseThing" -> "cmael-case-thing"
|
||||
uncamel :: String -> String -- "Model.Theme.CamelCaseThing" -> "camel-case-thing"
|
||||
uncamel = ("theme-" ++) . reverse . foldl helper []
|
||||
where
|
||||
helper _ '.' = []
|
||||
helper acc c
|
||||
| Char.isSpace c = acc
|
||||
| Char.isUpper c = Char.toLower c : '-' : acc
|
||||
| otherwise = c : acc
|
||||
| otherwise = c : acc
|
||||
|
||||
camelSpace :: String -> String -- "Model.Theme.CamelCaseThing" -> "Camel Case Thing"
|
||||
camelSpace = reverse . foldl helper []
|
||||
where
|
||||
helper _ '.' = []
|
||||
helper acc c
|
||||
| Char.isSpace c = acc
|
||||
| Char.isUpper c = c : ' ' : acc
|
||||
| otherwise = c : acc
|
||||
|
||||
-- Convert anything to Text, and I don't care how
|
||||
class DisplayAble a where
|
||||
|
||||
@ -53,16 +53,19 @@ altFun perm = lamE pat rhs
|
||||
|
||||
-- Special Show-Instances for Themes
|
||||
deriveShowWith :: (String -> String) -> Name -> Q [Dec]
|
||||
deriveShowWith strOp ty = do
|
||||
deriveShowWith = deriveSimpleWith ''Show 'show
|
||||
|
||||
deriveSimpleWith :: Name -> Name -> (String -> String) -> Name -> Q [Dec]
|
||||
deriveSimpleWith cls fun strOp ty = do
|
||||
(TyConI tyCon) <- reify ty
|
||||
(tyConName, cs) <- case tyCon of
|
||||
DataD [] nm [] _ cs _ -> return (nm, cs)
|
||||
_ -> fail "deriveShowTheme: tyCon must be a plain datatype enumeration"
|
||||
let instanceT = conT ''Show `appT` conT tyConName
|
||||
let instanceT = conT cls `appT` conT tyConName
|
||||
return <$> instanceD (return []) instanceT [genDecs cs]
|
||||
where
|
||||
genDecs :: [Con] -> Q Dec
|
||||
genDecs cs = funD 'show (map genClause cs)
|
||||
genDecs cs = funD fun (map genClause cs)
|
||||
|
||||
genClause :: Con -> Q Clause
|
||||
genClause (NormalC name []) =
|
||||
|
||||
Loading…
Reference in New Issue
Block a user