module Hercules.Agent.NixPath
  ( renderNixPath,
    renderNixPathElement,
    renderSubPath,
  )
where

import qualified Data.Text as T
import qualified Hercules.API.Agent.Evaluate.EvaluateTask as EvaluateTask
import Protolude

renderNixPath ::
  [EvaluateTask.NixPathElement (EvaluateTask.SubPathOf FilePath)] ->
  Text
renderNixPath :: [NixPathElement (SubPathOf FilePath)] -> Text
renderNixPath = Text -> [Text] -> Text
T.intercalate Text
":" ([Text] -> Text)
-> ([NixPathElement (SubPathOf FilePath)] -> [Text])
-> [NixPathElement (SubPathOf FilePath)]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NixPathElement (SubPathOf FilePath) -> Text)
-> [NixPathElement (SubPathOf FilePath)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map NixPathElement (SubPathOf FilePath) -> Text
renderNixPathElement

renderNixPathElement ::
  EvaluateTask.NixPathElement
    (EvaluateTask.SubPathOf FilePath) ->
  Text
renderNixPathElement :: NixPathElement (SubPathOf FilePath) -> Text
renderNixPathElement NixPathElement (SubPathOf FilePath)
pe =
  (Text -> Text) -> Maybe Text -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=") (NixPathElement (SubPathOf FilePath) -> Maybe Text
forall a. NixPathElement a -> Maybe Text
EvaluateTask.prefix NixPathElement (SubPathOf FilePath)
pe)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SubPathOf Text -> Text
renderSubPath (FilePath -> Text
forall a b. ConvertText a b => a -> b
toS (FilePath -> Text) -> SubPathOf FilePath -> SubPathOf Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixPathElement (SubPathOf FilePath) -> SubPathOf FilePath
forall a. NixPathElement a -> a
EvaluateTask.value NixPathElement (SubPathOf FilePath)
pe)

renderSubPath :: EvaluateTask.SubPathOf Text -> Text
renderSubPath :: SubPathOf Text -> Text
renderSubPath SubPathOf Text
sp =
  Text -> Text
forall a b. ConvertText a b => a -> b
toS (SubPathOf Text -> Text
forall a. SubPathOf a -> a
EvaluateTask.path SubPathOf Text
sp) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> Maybe Text -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (SubPathOf Text -> Maybe Text
forall a. SubPathOf a -> Maybe Text
EvaluateTask.subPath SubPathOf Text
sp)