diff --git a/Model.hs b/Model.hs index 693366b..8df0423 100644 --- a/Model.hs +++ b/Model.hs @@ -2,10 +2,7 @@ module Model where import ClassyPrelude.Yesod import Database.Persist.Quasi -import Data.Aeson -import Data.Hashable (hashUsing) import Data.Slug (Slug, SnapSlug) -import qualified Data.Text as Text import Types -- You can define all of your database entities in the entities file. @@ -14,28 +11,3 @@ import Types -- http://www.yesodweb.com/book/persistent/ share [mkPersist sqlSettings, mkMigrate "migrateAll"] $(persistFileWith lowerCaseSettings "config/models") - - -ghcMajorVersionToText :: GhcMajorVersion -> Text -ghcMajorVersionToText (GhcMajorVersion major minor) - = pack (show major) <> "." <> pack (show minor) - -ghcMajorVersionFromText :: Text -> Maybe GhcMajorVersion -ghcMajorVersionFromText t = case Text.splitOn "." t of - [readMay -> Just major, readMay -> Just minor] -> - Just $ GhcMajorVersion major minor - _ -> Nothing - -instance Hashable GhcMajorVersion where - hashWithSalt = hashUsing ghcMajorVersionToText - -instance Eq GhcMajorVersion where - (GhcMajorVersion a b) == (GhcMajorVersion a' b') = - a == a' && b == b' - -instance FromJSON GhcMajorVersion where - parseJSON = withText "GhcMajorVersion" $ - maybe mzero return . ghcMajorVersionFromText - -instance ToJSON GhcMajorVersion where - toJSON = toJSON . ghcMajorVersionToText diff --git a/Types.hs b/Types.hs index 502baab..4035611 100644 --- a/Types.hs +++ b/Types.hs @@ -1,6 +1,7 @@ module Types where import ClassyPrelude.Yesod +import Data.Aeson import Data.BlobStore (ToPath (..), BackupToS3 (..)) import Data.Hashable (hashUsing) import Text.Blaze (ToMarkup) @@ -118,6 +119,40 @@ instance PathPiece StackageExecutable where fromPathPiece "stackage-setup.exe" = Just StackageWindowsExecutable fromPathPiece _ = Nothing +data GhcMajorVersion = GhcMajorVersion Int Int + deriving (Eq) + +ghcMajorVersionToText :: GhcMajorVersion -> Text +ghcMajorVersionToText (GhcMajorVersion a b) + = pack (show a) <> "." <> pack (show b) + +ghcMajorVersionFromText :: Text -> Maybe GhcMajorVersion +ghcMajorVersionFromText t = case T.splitOn "." t of + [readMay -> Just a, readMay -> Just b] -> + Just $ GhcMajorVersion a b + _ -> Nothing + +instance PersistFieldSql GhcMajorVersion where + sqlType = sqlType . liftM ghcMajorVersionToText + +instance PersistField GhcMajorVersion where + toPersistValue = toPersistValue . ghcMajorVersionToText + fromPersistValue v = do + t <- fromPersistValueText v + case ghcMajorVersionFromText t of + Just ver -> return ver + Nothing -> Left $ "Cannot convert to GhcMajorVersion: " <> t + +instance Hashable GhcMajorVersion where + hashWithSalt = hashUsing ghcMajorVersionToText + +instance FromJSON GhcMajorVersion where + parseJSON = withText "GhcMajorVersion" $ + maybe mzero return . ghcMajorVersionFromText + +instance ToJSON GhcMajorVersion where + toJSON = toJSON . ghcMajorVersionToText + data SupportedArch = Win32 diff --git a/config/models b/config/models index 3312cc7..acc4aab 100644 --- a/config/models +++ b/config/models @@ -132,8 +132,3 @@ Suggested UploadProgress message Text dest Text Maybe - -GhcMajorVersion - major Int - minor Int - UniqueGhcMajorVersion major minor