{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Types.Cache
( ConfigCacheType(..)
, Action(..)
) where
import qualified Data.Text as T
import Database.Persist.Sql
import Stack.Prelude
import Stack.Types.GhcPkgId
data ConfigCacheType
= ConfigCacheTypeConfig
| ConfigCacheTypeFlagLibrary GhcPkgId
| ConfigCacheTypeFlagExecutable PackageIdentifier
deriving (Eq, Show)
instance PersistField ConfigCacheType where
toPersistValue ConfigCacheTypeConfig = PersistText "config"
toPersistValue (ConfigCacheTypeFlagLibrary v) =
PersistText $ "lib:" <> unGhcPkgId v
toPersistValue (ConfigCacheTypeFlagExecutable v) =
PersistText $ "exe:" <> T.pack (packageIdentifierString v)
fromPersistValue (PersistText t) =
fromMaybe (Left $ "Unexected ConfigCacheType value: " <> t) $
config <|> fmap lib (T.stripPrefix "lib:" t) <|>
fmap exe (T.stripPrefix "exe:" t)
where
config
| t == "config" = Just (Right ConfigCacheTypeConfig)
| otherwise = Nothing
lib v = do
ghcPkgId <- mapLeft tshow (parseGhcPkgId v)
Right $ ConfigCacheTypeFlagLibrary ghcPkgId
exe v = do
pkgId <-
maybe (Left $ "Unexpected ConfigCacheType value: " <> t) Right $
parsePackageIdentifier (T.unpack v)
Right $ ConfigCacheTypeFlagExecutable pkgId
fromPersistValue _ = Left "Unexected ConfigCacheType type"
instance PersistFieldSql ConfigCacheType where
sqlType _ = SqlString
data Action
= UpgradeCheck
deriving (Show, Eq, Ord)
instance PersistField Action where
toPersistValue UpgradeCheck = PersistInt64 1
fromPersistValue (PersistInt64 1) = Right UpgradeCheck
fromPersistValue x = Left $ T.pack $ "Invalid Action: " ++ show x
instance PersistFieldSql Action where
sqlType _ = SqlInt64