{-# LANGUAGE OverloadedStrings #-}

module System.Nix.Derivation (
    parseDerivation
  , buildDerivation
  ) where

import Data.Attoparsec.Text.Lazy (Parser)
import Data.Text (Text)
import Data.Text.Lazy.Builder (Builder)
import Nix.Derivation (Derivation)
import System.Nix.StorePath (StorePath)

import qualified Data.Text
import qualified Data.Text.Lazy.Builder

import qualified Nix.Derivation
import qualified System.Nix.StorePath

parseDerivation :: FilePath -> Parser (Derivation StorePath Text)
parseDerivation :: FilePath -> Parser (Derivation StorePath Text)
parseDerivation FilePath
expectedRoot =
  Parser StorePath
-> Parser Text -> Parser (Derivation StorePath Text)
forall fp txt.
(Ord fp, Ord txt) =>
Parser fp -> Parser txt -> Parser (Derivation fp txt)
Nix.Derivation.parseDerivationWith
    (Parser Text
"\"" Parser Text -> Parser StorePath -> Parser StorePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> FilePath -> Parser StorePath
System.Nix.StorePath.pathParser FilePath
expectedRoot Parser StorePath -> Parser Text -> Parser StorePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
"\"")
    Parser Text
Nix.Derivation.textParser

buildDerivation :: Derivation StorePath Text -> Builder
buildDerivation :: Derivation StorePath Text -> Builder
buildDerivation Derivation StorePath Text
derivation =
  (StorePath -> Builder)
-> (Text -> Builder) -> Derivation StorePath Text -> Builder
forall fp txt.
(fp -> Builder) -> (txt -> Builder) -> Derivation fp txt -> Builder
Nix.Derivation.buildDerivationWith
    (Text -> Builder
string (Text -> Builder) -> (StorePath -> Text) -> StorePath -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Data.Text.pack (FilePath -> Text) -> (StorePath -> FilePath) -> StorePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath -> FilePath
forall a. Show a => a -> FilePath
show)
    Text -> Builder
string
    Derivation StorePath Text
derivation
  where
    string :: Text -> Builder
string = Text -> Builder
Data.Text.Lazy.Builder.fromText (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Data.Text.pack (FilePath -> Text) -> (Text -> FilePath) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. Show a => a -> FilePath
show