{-# LANGUAGE NoImplicitPrelude #-}
module Stack.Types.GHCVariant
( GHCVariant (..)
, HasGHCVariant (..)
, ghcVariantName
, ghcVariantSuffix
, parseGHCVariant
) where
import Data.List ( stripPrefix )
import qualified Data.Text as T
import Pantry.Internal.AesonExtended ( FromJSON, parseJSON, withText )
import Stack.Prelude
data GHCVariant
= GHCStandard
| GHCIntegerSimple
| GHCNativeBignum
| GHCCustom String
deriving Int -> GHCVariant -> ShowS
[GHCVariant] -> ShowS
GHCVariant -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHCVariant] -> ShowS
$cshowList :: [GHCVariant] -> ShowS
show :: GHCVariant -> String
$cshow :: GHCVariant -> String
showsPrec :: Int -> GHCVariant -> ShowS
$cshowsPrec :: Int -> GHCVariant -> ShowS
Show
instance FromJSON GHCVariant where
parseJSON :: Value -> Parser GHCVariant
parseJSON =
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText
String
"GHCVariant"
(forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThrow m => String -> m GHCVariant
parseGHCVariant forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
class HasGHCVariant env where
ghcVariantL :: SimpleGetter env GHCVariant
instance HasGHCVariant GHCVariant where
ghcVariantL :: SimpleGetter GHCVariant GHCVariant
ghcVariantL = forall a. a -> a
id
{-# INLINE ghcVariantL #-}
ghcVariantName :: GHCVariant -> String
ghcVariantName :: GHCVariant -> String
ghcVariantName GHCVariant
GHCStandard = String
"standard"
ghcVariantName GHCVariant
GHCIntegerSimple = String
"integersimple"
ghcVariantName GHCVariant
GHCNativeBignum = String
"int-native"
ghcVariantName (GHCCustom String
name) = String
"custom-" forall a. [a] -> [a] -> [a]
++ String
name
ghcVariantSuffix :: GHCVariant -> String
ghcVariantSuffix :: GHCVariant -> String
ghcVariantSuffix GHCVariant
GHCStandard = String
""
ghcVariantSuffix GHCVariant
v = String
"-" forall a. [a] -> [a] -> [a]
++ GHCVariant -> String
ghcVariantName GHCVariant
v
parseGHCVariant :: (MonadThrow m) => String -> m GHCVariant
parseGHCVariant :: forall (m :: * -> *). MonadThrow m => String -> m GHCVariant
parseGHCVariant String
s =
case forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"custom-" String
s of
Just String
name -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> GHCVariant
GHCCustom String
name)
Maybe String
Nothing
| String
s forall a. Eq a => a -> a -> Bool
== String
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCVariant
GHCStandard
| String
s forall a. Eq a => a -> a -> Bool
== String
"standard" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCVariant
GHCStandard
| String
s forall a. Eq a => a -> a -> Bool
== String
"integersimple" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCVariant
GHCIntegerSimple
| String
s forall a. Eq a => a -> a -> Bool
== String
"int-native" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCVariant
GHCNativeBignum
| Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> GHCVariant
GHCCustom String
s)