{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}

-- | Parsing logic

module Nix.Derivation.Parser
    ( -- * Parser
      parseDerivation
    , parseDerivationWith
    , textParser
    ) where

import Data.Attoparsec.Text.Lazy (Parser)
import Data.Map (Map)
import Data.Set (Set)
import Data.Text (Text)
import Data.Vector (Vector)
import Nix.Derivation.Types (Derivation(..), DerivationOutput(..))

import qualified Data.Attoparsec.Text
import qualified Data.Attoparsec.Text.Lazy
import qualified Data.Map
import qualified Data.Set
import qualified Data.Text
import qualified Data.Vector
import qualified System.FilePath

listOf :: Parser a -> Parser [a]
listOf :: Parser a -> Parser [a]
listOf Parser a
element = do
    Parser Text Text
"["
    [a]
es <- Parser a -> Parser Text Text -> Parser [a]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
Data.Attoparsec.Text.Lazy.sepBy Parser a
element Parser Text Text
","
    Parser Text Text
"]"
    [a] -> Parser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
es

-- | Parse a derivation
parseDerivation :: Parser (Derivation FilePath Text)
parseDerivation :: Parser (Derivation FilePath Text)
parseDerivation = Parser FilePath
-> Parser Text Text -> Parser (Derivation FilePath Text)
forall fp txt.
(Ord fp, Ord txt) =>
Parser fp -> Parser txt -> Parser (Derivation fp txt)
parseDerivationWith Parser FilePath
filepathParser Parser Text Text
textParser

-- | Parse a derivation using custom
-- parsers for filepaths and text fields
parseDerivationWith :: (Ord fp, Ord txt) => Parser fp -> Parser txt -> Parser (Derivation fp txt)
parseDerivationWith :: Parser fp -> Parser txt -> Parser (Derivation fp txt)
parseDerivationWith Parser fp
filepath Parser txt
string = do
    Parser Text Text
"Derive("

    let keyValue0 :: Parser Text (txt, DerivationOutput fp txt)
keyValue0 = do
            Parser Text Text
"("
            txt
key <- Parser txt
string
            Parser Text Text
","
            fp
path <- Parser fp
filepath
            Parser Text Text
","
            txt
hashAlgo <- Parser txt
string
            Parser Text Text
","
            txt
hash <- Parser txt
string
            Parser Text Text
")"
            (txt, DerivationOutput fp txt)
-> Parser Text (txt, DerivationOutput fp txt)
forall (m :: * -> *) a. Monad m => a -> m a
return (txt
key, DerivationOutput :: forall fp txt. fp -> txt -> txt -> DerivationOutput fp txt
DerivationOutput {fp
txt
hash :: txt
hashAlgo :: txt
path :: fp
hash :: txt
hashAlgo :: txt
path :: fp
..})
    Map txt (DerivationOutput fp txt)
outputs <- Parser Text (txt, DerivationOutput fp txt)
-> Parser (Map txt (DerivationOutput fp txt))
forall k v. Ord k => Parser (k, v) -> Parser (Map k v)
mapOf Parser Text (txt, DerivationOutput fp txt)
keyValue0

    Parser Text Text
","

    let keyValue1 :: Parser Text (fp, Set txt)
keyValue1 = do
            Parser Text Text
"("
            fp
key <- Parser fp
filepath
            Parser Text Text
","
            Set txt
value <- Parser txt -> Parser (Set txt)
forall a. Ord a => Parser a -> Parser (Set a)
setOf Parser txt
string
            Parser Text Text
")"
            (fp, Set txt) -> Parser Text (fp, Set txt)
forall (m :: * -> *) a. Monad m => a -> m a
return (fp
key, Set txt
value)
    Map fp (Set txt)
inputDrvs <- Parser Text (fp, Set txt) -> Parser (Map fp (Set txt))
forall k v. Ord k => Parser (k, v) -> Parser (Map k v)
mapOf Parser Text (fp, Set txt)
keyValue1

    Parser Text Text
","

    Set fp
inputSrcs <- Parser fp -> Parser (Set fp)
forall a. Ord a => Parser a -> Parser (Set a)
setOf Parser fp
filepath

    Parser Text Text
","

    txt
platform <- Parser txt
string

    Parser Text Text
","

    txt
builder <- Parser txt
string

    Parser Text Text
","

    Vector txt
args <- Parser txt -> Parser (Vector txt)
forall a. Parser a -> Parser (Vector a)
vectorOf Parser txt
string

    Parser Text Text
","

    let keyValue2 :: Parser Text (txt, txt)
keyValue2 = do
            Parser Text Text
"("
            txt
key <- Parser txt
string
            Parser Text Text
","
            txt
value <- Parser txt
string
            Parser Text Text
")"
            (txt, txt) -> Parser Text (txt, txt)
forall (m :: * -> *) a. Monad m => a -> m a
return (txt
key, txt
value)
    Map txt txt
env <- Parser Text (txt, txt) -> Parser (Map txt txt)
forall k v. Ord k => Parser (k, v) -> Parser (Map k v)
mapOf Parser Text (txt, txt)
keyValue2

    Parser Text Text
")"

    Derivation fp txt -> Parser (Derivation fp txt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Derivation :: forall fp txt.
Map txt (DerivationOutput fp txt)
-> Map fp (Set txt)
-> Set fp
-> txt
-> txt
-> Vector txt
-> Map txt txt
-> Derivation fp txt
Derivation {txt
Map fp (Set txt)
Map txt txt
Map txt (DerivationOutput fp txt)
Set fp
Vector txt
env :: Map txt txt
args :: Vector txt
builder :: txt
platform :: txt
inputSrcs :: Set fp
inputDrvs :: Map fp (Set txt)
outputs :: Map txt (DerivationOutput fp txt)
env :: Map txt txt
args :: Vector txt
builder :: txt
platform :: txt
inputSrcs :: Set fp
inputDrvs :: Map fp (Set txt)
outputs :: Map txt (DerivationOutput fp txt)
..})

textParser :: Parser Text
textParser :: Parser Text Text
textParser = do
    Parser Text Text
"\""

    let predicate :: Char -> Bool
predicate Char
c = Bool -> Bool
not (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')

    let loop :: Parser Text [Text]
loop = do
            Text
text0 <- (Char -> Bool) -> Parser Text Text
Data.Attoparsec.Text.takeWhile Char -> Bool
predicate

            Char
char0 <- Parser Char
Data.Attoparsec.Text.anyChar

            case Char
char0 of
                Char
'"'  -> do
                    [Text] -> Parser Text [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Text
text0 ]

                Char
_    -> do
                    Char
char1 <- Parser Char
Data.Attoparsec.Text.anyChar

                    Char
char2 <- case Char
char1 of
                        Char
'n' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
                        Char
'r' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\r'
                        Char
't' -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\t'
                        Char
_   -> Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
char1

                    [Text]
textChunks <- Parser Text [Text]
loop

                    [Text] -> Parser Text [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
text0 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Char -> Text
Data.Text.singleton Char
char2 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
textChunks)

    [Text]
textChunks <- Parser Text [Text]
loop

    Text -> Parser Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Text
Data.Text.concat [Text]
textChunks)

filepathParser :: Parser FilePath
filepathParser :: Parser FilePath
filepathParser = do
    Text
text <- Parser Text Text
textParser
    let str :: FilePath
str = Text -> FilePath
Data.Text.unpack Text
text
    case (Text -> Maybe (Char, Text)
Data.Text.uncons Text
text, FilePath -> Bool
System.FilePath.isValid FilePath
str) of
        (Just (Char
'/', Text
_), Bool
True) -> do
            FilePath -> Parser FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
str
        (Maybe (Char, Text), Bool)
_ -> do
            FilePath -> Parser FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"bad path ‘" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
Data.Text.unpack Text
text FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"’ in derivation")

setOf :: Ord a => Parser a -> Parser (Set a)
setOf :: Parser a -> Parser (Set a)
setOf Parser a
element = do
    [a]
es <- Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
listOf Parser a
element
    Set a -> Parser (Set a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Set a
forall a. Ord a => [a] -> Set a
Data.Set.fromList [a]
es)

vectorOf :: Parser a -> Parser (Vector a)
vectorOf :: Parser a -> Parser (Vector a)
vectorOf Parser a
element = do
    [a]
es <- Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
listOf Parser a
element
    Vector a -> Parser (Vector a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Vector a
forall a. [a] -> Vector a
Data.Vector.fromList [a]
es)

mapOf :: Ord k => Parser (k, v) -> Parser (Map k v)
mapOf :: Parser (k, v) -> Parser (Map k v)
mapOf Parser (k, v)
keyValue = do
    [(k, v)]
keyValues <- Parser (k, v) -> Parser [(k, v)]
forall a. Parser a -> Parser [a]
listOf Parser (k, v)
keyValue
    Map k v -> Parser (Map k v)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(k, v)]
keyValues)