{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Types.Platform
  ( PlatformVariant (..)
  , HasPlatform (..)
  , platformVariantSuffix
  , platformOnlyRelDir
  ) where

import           Distribution.System ( Platform )
import           Distribution.Text ( display )
import           Lens.Micro ( _1, _2 )
import           Path ( parseRelDir )
import           Stack.Prelude

-- | A variant of the platform, used to differentiate Docker builds from host

data PlatformVariant
  = PlatformVariantNone
  | PlatformVariant String

-- | Class for environment values which have a Platform

class HasPlatform env where
  platformL :: Lens' env Platform
  platformVariantL :: Lens' env PlatformVariant

instance HasPlatform (Platform, PlatformVariant) where
  platformL :: Lens' (Platform, PlatformVariant) Platform
platformL = (Platform -> f Platform)
-> (Platform, PlatformVariant) -> f (Platform, PlatformVariant)
forall s t a b. Field1 s t a b => Lens s t a b
Lens' (Platform, PlatformVariant) Platform
_1
  platformVariantL :: Lens' (Platform, PlatformVariant) PlatformVariant
platformVariantL = (PlatformVariant -> f PlatformVariant)
-> (Platform, PlatformVariant) -> f (Platform, PlatformVariant)
forall s t a b. Field2 s t a b => Lens s t a b
Lens' (Platform, PlatformVariant) PlatformVariant
_2

-- | Render a platform variant to a String suffix.

platformVariantSuffix :: PlatformVariant -> String
platformVariantSuffix :: PlatformVariant -> String
platformVariantSuffix PlatformVariant
PlatformVariantNone = String
""
platformVariantSuffix (PlatformVariant String
v) = String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v

-- | Relative directory for the platform identifier

platformOnlyRelDir ::
     (MonadReader env m, HasPlatform env, MonadThrow m)
  => m (Path Rel Dir)
platformOnlyRelDir :: forall env (m :: * -> *).
(MonadReader env m, HasPlatform env, MonadThrow m) =>
m (Path Rel Dir)
platformOnlyRelDir = do
  Platform
platform <- Getting Platform env Platform -> m Platform
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Platform env Platform
forall env. HasPlatform env => Lens' env Platform
Lens' env Platform
platformL
  PlatformVariant
platformVariant <- Getting PlatformVariant env PlatformVariant -> m PlatformVariant
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PlatformVariant env PlatformVariant
forall env. HasPlatform env => Lens' env PlatformVariant
Lens' env PlatformVariant
platformVariantL
  String -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir
    (  Platform -> String
forall a. Pretty a => a -> String
Distribution.Text.display Platform
platform
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ PlatformVariant -> String
platformVariantSuffix PlatformVariant
platformVariant
    )