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

module Nix.NarInfo.Parser
  ( -- * Parser
    parseNarInfo
  , parseNarInfoWith
  ) where

import Data.Set (Set)
import Data.Text (Text)
import Data.Attoparsec.Text (Parser)
import Nix.NarInfo.Types

import qualified Control.Applicative
import qualified Data.Char
import qualified Data.Set
import qualified Data.Text
import qualified Data.Attoparsec.Text

parseNarInfo :: Parser (NarInfo FilePath Text Text)
parseNarInfo :: Parser (NarInfo FilePath Text Text)
parseNarInfo = (Bool -> Parser FilePath)
-> Parser Text
-> Parser Text
-> Parser (NarInfo FilePath Text Text)
forall fp txt hash.
Ord fp =>
(Bool -> Parser fp)
-> Parser txt -> Parser hash -> Parser (NarInfo fp txt hash)
parseNarInfoWith Bool -> Parser FilePath
forall {p}. p -> Parser FilePath
pathParse Parser Text
textParse Parser Text
hashParse
  where
    textParse :: Parser Text
textParse = (Char -> Bool) -> Parser Text
Data.Attoparsec.Text.takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Data.Char.isSpace)
    pathParse :: p -> Parser FilePath
pathParse p
_hasPrefix = Text -> FilePath
Data.Text.unpack (Text -> FilePath) -> Parser Text -> Parser FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
textParse
    hashParse :: Parser Text
hashParse = Parser Text
textParse

parseNarInfoWith :: (Ord fp)
                 => (Bool -> Parser fp) -- True when path prefix is present
                 -> Parser txt
                 -> Parser hash
                 -> Parser (NarInfo fp txt hash)
parseNarInfoWith :: forall fp txt hash.
Ord fp =>
(Bool -> Parser fp)
-> Parser txt -> Parser hash -> Parser (NarInfo fp txt hash)
parseNarInfoWith Bool -> Parser fp
pathParser Parser txt
textParser Parser hash
hashParser = do
  fp
storePath   <- Text -> Parser fp
keyPath Text
"StorePath"
  txt
url         <- Text -> Parser txt
key     Text
"URL"
  txt
compression <- Text -> Parser txt
key     Text
"Compression"
  hash
fileHash    <- Text -> Parser hash
keyHash Text
"FileHash"
  Integer
fileSize    <- Text -> Parser Text Integer
forall {b}. Integral b => Text -> Parser Text b
keyNum  Text
"FileSize"
  hash
narHash     <- Text -> Parser hash
keyHash Text
"NarHash"
  Integer
narSize     <- Text -> Parser Text Integer
forall {b}. Integral b => Text -> Parser Text b
keyNum  Text
"NarSize"

  Set fp
references  <- [fp] -> Set fp
forall a. Ord a => [a] -> Set a
Data.Set.fromList ([fp] -> Set fp) -> Parser Text [fp] -> Parser Text (Set fp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text [fp] -> Parser Text [fp]
forall {b}. Text -> Parser Text b -> Parser Text b
parseKey Text
"References" (Parser Text [fp] -> Parser Text [fp])
-> Parser Text [fp] -> Parser Text [fp]
forall a b. (a -> b) -> a -> b
$
    (Bool -> Parser fp
pathParser Bool
False) Parser fp -> Parser Text Char -> Parser Text [fp]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`Data.Attoparsec.Text.sepBy` Char -> Parser Text Char
Data.Attoparsec.Text.char Char
' ')

  Maybe txt
deriver     <- Text -> Parser Text (Maybe txt)
optKey Text
"Deriver"
  Maybe txt
system      <- Text -> Parser Text (Maybe txt)
optKey Text
"System"
  Maybe txt
sig         <- Text -> Parser Text (Maybe txt)
optKey Text
"Sig"
  Maybe txt
ca          <- Text -> Parser Text (Maybe txt)
optKey Text
"Ca"

  NarInfo fp txt hash -> Parser (NarInfo fp txt hash)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (NarInfo fp txt hash -> Parser (NarInfo fp txt hash))
-> NarInfo fp txt hash -> Parser (NarInfo fp txt hash)
forall a b. (a -> b) -> a -> b
$ NarInfo {fp
txt
hash
Integer
Maybe txt
Set fp
storePath :: fp
url :: txt
compression :: txt
fileHash :: hash
fileSize :: Integer
narHash :: hash
narSize :: Integer
references :: Set fp
deriver :: Maybe txt
system :: Maybe txt
sig :: Maybe txt
ca :: Maybe txt
storePath :: fp
url :: txt
compression :: txt
fileHash :: hash
fileSize :: Integer
narHash :: hash
narSize :: Integer
references :: Set fp
deriver :: Maybe txt
system :: Maybe txt
sig :: Maybe txt
ca :: Maybe txt
..}
  where
    parseKey :: Text -> Parser Text b -> Parser Text b
parseKey Text
key Parser Text b
parser = do
      Text -> Parser Text
Data.Attoparsec.Text.string Text
key
      Text -> Parser Text
Data.Attoparsec.Text.string Text
": "
      b
out <- Parser Text b
parser
      Char -> Parser Text Char
Data.Attoparsec.Text.char Char
'\n'
      b -> Parser Text b
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return b
out

    key :: Text -> Parser txt
key = (Text -> Parser txt -> Parser txt)
-> Parser txt -> Text -> Parser txt
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Parser txt -> Parser txt
forall {b}. Text -> Parser Text b -> Parser Text b
parseKey Parser txt
textParser
    optKey :: Text -> Parser Text (Maybe txt)
optKey = Parser txt -> Parser Text (Maybe txt)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Control.Applicative.optional (Parser txt -> Parser Text (Maybe txt))
-> (Text -> Parser txt) -> Text -> Parser Text (Maybe txt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parser txt
key
    keyNum :: Text -> Parser Text b
keyNum Text
x = Text -> Parser Text b -> Parser Text b
forall {b}. Text -> Parser Text b -> Parser Text b
parseKey Text
x Parser Text b
forall a. Integral a => Parser a
Data.Attoparsec.Text.decimal
    keyPath :: Text -> Parser fp
keyPath Text
x = Text -> Parser fp -> Parser fp
forall {b}. Text -> Parser Text b -> Parser Text b
parseKey Text
x (Bool -> Parser fp
pathParser Bool
True)
    keyHash :: Text -> Parser hash
keyHash Text
x = Text -> Parser hash -> Parser hash
forall {b}. Text -> Parser Text b -> Parser Text b
parseKey Text
x Parser hash
hashParser