DerivedPath.hs

{-# LANGUAGE OverloadedStrings #-}

module System.Nix.DerivedPath (
    OutputsSpec(..)
  , DerivedPath(..)
  , ParseOutputsError(..)
  , parseOutputsSpec
  , outputsSpecToText
  , parseDerivedPath
  , derivedPathToText
  ) where

import GHC.Generics (Generic)
import Data.Set (Set)
import Data.Text (Text)
import System.Nix.OutputName (OutputName, InvalidNameError)
import System.Nix.StorePath (StoreDir(..), StorePath, InvalidPathError)

import qualified Data.Bifunctor
import qualified Data.ByteString.Char8
import qualified Data.Set
import qualified Data.Text
import qualified System.Nix.OutputName
import qualified System.Nix.StorePath

data OutputsSpec =
    OutputsSpec_All
  -- ^ Wildcard spec (^*) meaning all outputs
  | OutputsSpec_Names (Set OutputName)
  -- ^ Set of specific outputs
  deriving (Eq, Generic, Ord, Show)

data DerivedPath =
    DerivedPath_Opaque StorePath
  -- ^ Fully evaluated store path that can't be built
  -- but can be fetched
  | DerivedPath_Built StorePath OutputsSpec
  -- ^ Derivation path and the outputs built from it
  deriving (Eq, Generic, Ord, Show)

data ParseOutputsError =
    ParseOutputsError_InvalidPath InvalidPathError
  | ParseOutputsError_InvalidName InvalidNameError
  | ParseOutputsError_NoNames
  | ParseOutputsError_NoPrefix StoreDir Text
  deriving (Eq, Ord, Show)

parseOutputsSpec :: Text -> Either ParseOutputsError OutputsSpec
parseOutputsSpec t
  | t == "*" = Right OutputsSpec_All
  | otherwise = do
  names <- mapM
             ( Data.Bifunctor.first
                 ParseOutputsError_InvalidName
             . System.Nix.OutputName.mkOutputName
             )
             (Data.Text.splitOn "," t)
  if null names
    then Left ParseOutputsError_NoNames
    else Right $ OutputsSpec_Names (Data.Set.fromList names)

outputsSpecToText :: OutputsSpec -> Text
outputsSpecToText = \case
  OutputsSpec_All -> "*"
  OutputsSpec_Names ns ->
    Data.Text.intercalate
      ","
      (fmap System.Nix.OutputName.unOutputName
        (Data.Set.toList ns)
      )

parseDerivedPath
  :: StoreDir
  -> Text
  -> Either ParseOutputsError DerivedPath
parseDerivedPath root@(StoreDir sd) path =
  let -- We need to do a bit more legwork for case
      -- when StoreDir contains '!'
      -- which is generated by its Arbitrary instance
    textRoot = Data.Text.pack
               $ Data.ByteString.Char8.unpack sd

  in case Data.Text.stripPrefix textRoot path of
    Nothing -> Left $ ParseOutputsError_NoPrefix root path
    Just woRoot ->
      case Data.Text.breakOn "!" woRoot of
        (pathNoPrefix, r) ->
          if Data.Text.null r
          then DerivedPath_Opaque
               <$> (convertError
                   $ System.Nix.StorePath.parsePathFromText
                      root
                      path
                   )
          else DerivedPath_Built
               <$> (convertError
                   $ System.Nix.StorePath.parsePathFromText
                       root
                       (textRoot <> pathNoPrefix)
                   )
               <*> parseOutputsSpec (Data.Text.drop (Data.Text.length "!") r)
  where
    convertError
      :: Either InvalidPathError a
      -> Either ParseOutputsError a
    convertError = Data.Bifunctor.first ParseOutputsError_InvalidPath

derivedPathToText :: StoreDir -> DerivedPath -> Text
derivedPathToText root = \case
  DerivedPath_Opaque p ->
    System.Nix.StorePath.storePathToText root p
  DerivedPath_Built p os ->
    System.Nix.StorePath.storePathToText root p
    <> "!"
    <> outputsSpecToText os