diff --git a/src/Model/Types.hs b/src/Model/Types.hs index 539cc9bbb..de07f15a7 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -12,6 +12,8 @@ module Model.Types where import ClassyPrelude import Utils +import Data.Map (Map) +import qualified Data.Map as Map import Data.Fixed import Database.Persist.TH @@ -23,7 +25,7 @@ import Web.HttpApiData import Data.Text (Text) import qualified Data.Text as Text -import Text.Read (readMaybe) +import Text.Read (readMaybe,readsPrec) -- import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI @@ -183,6 +185,7 @@ data StudyFieldType = FieldPrimary | FieldSecondary derivePersistField "StudyFieldType" +-- Skins / Themes data Theme = Default | NeutralBlue @@ -190,17 +193,21 @@ data Theme | MintGreen | SkyLove deriving (Eq,Ord,Bounded,Enum) + $(deriveShowTheme ''Theme) allThemes :: [Theme] allThemes = [minBound..maxBound] --- instance Show Theme where --- show Default = "default" --- - - - --- derivePersistField "Theme" +readTheme :: Map String Theme +readTheme = Map.fromList [ (show t,t) | t <- allThemes ] + +instance Read Theme where +-- readPrec = undefined + readsPrec _ s + | (Just t) <- (Map.lookup s readTheme) = [(t,"")] + | otherwise = [] + +derivePersistField "Theme"