{-# LANGUAGE OverloadedStrings #-}

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

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

import qualified Data.ByteString.Char8
import qualified Data.Text
import qualified Data.Text.Lazy.Builder
import qualified Data.Attoparsec.Text.Lazy

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