{-# 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

-- | Type of config cache

data ConfigCacheType
    = ConfigCacheTypeConfig
    | ConfigCacheTypeFlagLibrary GhcPkgId
    | ConfigCacheTypeFlagExecutable PackageIdentifier
    deriving (ConfigCacheType -> ConfigCacheType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigCacheType -> ConfigCacheType -> Bool
$c/= :: ConfigCacheType -> ConfigCacheType -> Bool
== :: ConfigCacheType -> ConfigCacheType -> Bool
$c== :: ConfigCacheType -> ConfigCacheType -> Bool
Eq, Int -> ConfigCacheType -> ShowS
[ConfigCacheType] -> ShowS
ConfigCacheType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigCacheType] -> ShowS
$cshowList :: [ConfigCacheType] -> ShowS
show :: ConfigCacheType -> String
$cshow :: ConfigCacheType -> String
showsPrec :: Int -> ConfigCacheType -> ShowS
$cshowsPrec :: Int -> ConfigCacheType -> ShowS
Show)

instance PersistField ConfigCacheType where
    toPersistValue :: ConfigCacheType -> PersistValue
toPersistValue ConfigCacheType
ConfigCacheTypeConfig = Text -> PersistValue
PersistText Text
"config"
    toPersistValue (ConfigCacheTypeFlagLibrary GhcPkgId
v) =
        Text -> PersistValue
PersistText forall a b. (a -> b) -> a -> b
$ Text
"lib:" forall a. Semigroup a => a -> a -> a
<> GhcPkgId -> Text
unGhcPkgId GhcPkgId
v
    toPersistValue (ConfigCacheTypeFlagExecutable PackageIdentifier
v) =
        Text -> PersistValue
PersistText forall a b. (a -> b) -> a -> b
$ Text
"exe:" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PackageIdentifier -> String
packageIdentifierString PackageIdentifier
v)
    fromPersistValue :: PersistValue -> Either Text ConfigCacheType
fromPersistValue (PersistText Text
t) =
        forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Unexpected ConfigCacheType value: " forall a. Semigroup a => a -> a -> a
<> Text
t) forall a b. (a -> b) -> a -> b
$
        forall {a}. Maybe (Either a ConfigCacheType)
config forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Text ConfigCacheType
lib (Text -> Text -> Maybe Text
T.stripPrefix Text
"lib:" Text
t) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Text ConfigCacheType
exe (Text -> Text -> Maybe Text
T.stripPrefix Text
"exe:" Text
t)
      where
        config :: Maybe (Either a ConfigCacheType)
config
            | Text
t forall a. Eq a => a -> a -> Bool
== Text
"config" = forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right ConfigCacheType
ConfigCacheTypeConfig)
            | Bool
otherwise = forall a. Maybe a
Nothing
        lib :: Text -> Either Text ConfigCacheType
lib Text
v = do
            GhcPkgId
ghcPkgId <- forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft forall a. Show a => a -> Text
tshow (forall (m :: * -> *). MonadThrow m => Text -> m GhcPkgId
parseGhcPkgId Text
v)
            forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ GhcPkgId -> ConfigCacheType
ConfigCacheTypeFlagLibrary GhcPkgId
ghcPkgId
        exe :: Text -> Either Text ConfigCacheType
exe Text
v = do
            PackageIdentifier
pkgId <-
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Unexpected ConfigCacheType value: " forall a. Semigroup a => a -> a -> a
<> Text
t) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
                String -> Maybe PackageIdentifier
parsePackageIdentifier (Text -> String
T.unpack Text
v)
            forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> ConfigCacheType
ConfigCacheTypeFlagExecutable PackageIdentifier
pkgId
    fromPersistValue PersistValue
_ = forall a b. a -> Either a b
Left Text
"Unexpected ConfigCacheType type"

instance PersistFieldSql ConfigCacheType where
    sqlType :: Proxy ConfigCacheType -> SqlType
sqlType Proxy ConfigCacheType
_ = SqlType
SqlString

data Action
  = UpgradeCheck
  deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show, Action -> Action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq, Eq Action
Action -> Action -> Bool
Action -> Action -> Ordering
Action -> Action -> Action
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Action -> Action -> Action
$cmin :: Action -> Action -> Action
max :: Action -> Action -> Action
$cmax :: Action -> Action -> Action
>= :: Action -> Action -> Bool
$c>= :: Action -> Action -> Bool
> :: Action -> Action -> Bool
$c> :: Action -> Action -> Bool
<= :: Action -> Action -> Bool
$c<= :: Action -> Action -> Bool
< :: Action -> Action -> Bool
$c< :: Action -> Action -> Bool
compare :: Action -> Action -> Ordering
$ccompare :: Action -> Action -> Ordering
Ord)
instance PersistField Action where
    toPersistValue :: Action -> PersistValue
toPersistValue Action
UpgradeCheck = Int64 -> PersistValue
PersistInt64 Int64
1
    fromPersistValue :: PersistValue -> Either Text Action
fromPersistValue (PersistInt64 Int64
1) = forall a b. b -> Either a b
Right Action
UpgradeCheck
    fromPersistValue PersistValue
x = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Invalid Action: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PersistValue
x
instance PersistFieldSql Action where
    sqlType :: Proxy Action -> SqlType
sqlType Proxy Action
_ = SqlType
SqlInt64