{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module    : Nix.JenkinsPlugins2Nix.Parser
-- Copyright : (c) 2017 Mateusz Kowalczyk
-- License   : BSD3
--
-- Parsers.
module Nix.JenkinsPlugins2Nix.Parser
  ( parseManifest
  , runParseManifest
  ) where

import           Control.Applicative
import           Control.Monad (void)
import qualified Data.Attoparsec.Text as A
import           Data.Either (either)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Monoid ((<>))
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Text (Text)
import qualified Data.Text as Text
import           Nix.JenkinsPlugins2Nix.Types

-- | Run parser on manifest file contents.
runParseManifest :: Text -> Either String Manifest
runParseManifest :: Text -> Either String Manifest
runParseManifest = Parser Manifest -> Text -> Either String Manifest
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser Manifest
parseManifest

-- | 'Manifest' parser.
parseManifest :: A.Parser Manifest
parseManifest :: Parser Manifest
parseManifest = do
  Map Text Text
kvs <- Parser (Map Text Text)
kvMap
  let getKey :: Text -> Either String Text
      getKey :: Text -> Either String Text
getKey Text
k = case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text Text
kvs of
        Maybe Text
Nothing -> String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Could not find " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Map Text Text -> String
forall a. Show a => a -> String
show Map Text Text
kvs
        Just Text
v -> Text -> Either String Text
forall a b. b -> Either a b
Right Text
v

      getKeyParsing :: Text -> A.Parser a -> Either String a
      getKeyParsing :: Text -> Parser a -> Either String a
getKeyParsing Text
k Parser a
p = Text -> Either String Text
getKey Text
k Either String Text -> (Text -> Either String a) -> Either String a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser a
p

      eManifest :: Either String Manifest
      eManifest :: Either String Manifest
eManifest = do
        Text
manifest_version' <- Text -> Either String Text
getKey Text
"Manifest-Version"
        Maybe Text
archiver_version' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Archiver-Version"
        Maybe Text
created_by' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Created-By"
        Maybe Text
built_by' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Built-By"
        Maybe Text
build_jdk' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Build-Jdk"
        Maybe Text
extension_name' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Extension-Name"
        Maybe Text
specification_title' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Specification-Title"
        Maybe Text
implementation_title' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Implementation-Title"
        Maybe Text
implementation_version' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Implementation-Version"
        Maybe Text
group_id' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Group-Id"
        Text
short_name' <- Text -> Either String Text
getKey Text
"Short-Name"
        Text
long_name' <- Text -> Either String Text
getKey Text
"Long-Name"
        Maybe Text
url' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Url"
        Text
plugin_version' <- Text -> Either String Text
getKey Text
"Plugin-Version"
        Maybe Text
hudson_version' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Hudson-Version"
        Maybe Text
jenkins_version' <- Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Either String Text -> Either String (Maybe Text))
-> Either String Text -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either String Text
getKey Text
"Jenkins-Version"
        Set PluginDependency
plugin_dependencies' <- (String -> Either String (Set PluginDependency))
-> (Set PluginDependency -> Either String (Set PluginDependency))
-> Either String (Set PluginDependency)
-> Either String (Set PluginDependency)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
_ -> Set PluginDependency -> Either String (Set PluginDependency)
forall a b. b -> Either a b
Right Set PluginDependency
forall a. Set a
Set.empty) Set PluginDependency -> Either String (Set PluginDependency)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Set PluginDependency)
 -> Either String (Set PluginDependency))
-> Either String (Set PluginDependency)
-> Either String (Set PluginDependency)
forall a b. (a -> b) -> a -> b
$
          Text
-> Parser (Set PluginDependency)
-> Either String (Set PluginDependency)
forall a. Text -> Parser a -> Either String a
getKeyParsing Text
"Plugin-Dependencies" Parser (Set PluginDependency)
parsePluginDependencies
        Set Text
plugin_developers' <- (String -> Either String (Set Text))
-> (Set Text -> Either String (Set Text))
-> Either String (Set Text)
-> Either String (Set Text)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
_ -> Set Text -> Either String (Set Text)
forall a b. b -> Either a b
Right Set Text
forall a. Set a
Set.empty) Set Text -> Either String (Set Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Set Text) -> Either String (Set Text))
-> Either String (Set Text) -> Either String (Set Text)
forall a b. (a -> b) -> a -> b
$
          Text -> Parser (Set Text) -> Either String (Set Text)
forall a. Text -> Parser a -> Either String a
getKeyParsing Text
"Plugin-Developers" Parser (Set Text)
parsePluginDevelopers
        Manifest -> Either String Manifest
forall (m :: * -> *) a. Monad m => a -> m a
return (Manifest -> Either String Manifest)
-> Manifest -> Either String Manifest
forall a b. (a -> b) -> a -> b
$! Manifest :: Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Text
-> Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Set PluginDependency
-> Set Text
-> Manifest
Manifest
          { manifest_version :: Text
manifest_version = Text
manifest_version'
          , archiver_version :: Maybe Text
archiver_version = Maybe Text
archiver_version'
          , created_by :: Maybe Text
created_by = Maybe Text
created_by'
          , built_by :: Maybe Text
built_by = Maybe Text
built_by'
          , build_jdk :: Maybe Text
build_jdk = Maybe Text
build_jdk'
          , extension_name :: Maybe Text
extension_name = Maybe Text
extension_name'
          , specification_title :: Maybe Text
specification_title = Maybe Text
specification_title'
          , implementation_title :: Maybe Text
implementation_title = Maybe Text
implementation_title'
          , implementation_version :: Maybe Text
implementation_version = Maybe Text
implementation_version'
          , group_id :: Maybe Text
group_id = Maybe Text
group_id'
          , short_name :: Text
short_name = Text
short_name'
          , long_name :: Text
long_name = Text
long_name'
          , url :: Maybe Text
url = Maybe Text
url'
          , plugin_version :: Text
plugin_version = Text
plugin_version'
          , hudson_version :: Maybe Text
hudson_version = Maybe Text
hudson_version'
          , jenkins_version :: Maybe Text
jenkins_version = Maybe Text
jenkins_version'
          , plugin_dependencies :: Set PluginDependency
plugin_dependencies = Set PluginDependency
plugin_dependencies'
          , plugin_developers :: Set Text
plugin_developers = Set Text
plugin_developers'
          }
  case Either String Manifest
eManifest of
    Left String
err -> String -> Parser Manifest
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Right Manifest
m -> Manifest -> Parser Manifest
forall (m :: * -> *) a. Monad m => a -> m a
return Manifest
m
  where
    parsePluginDevelopers :: A.Parser (Set Text)
    parsePluginDevelopers :: Parser (Set Text)
parsePluginDevelopers = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> (Text -> [Text]) -> Text -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
"," (Text -> Set Text) -> Parser Text Text -> Parser (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
A.takeText

    parsePluginDependencies :: A.Parser (Set PluginDependency)
    parsePluginDependencies :: Parser (Set PluginDependency)
parsePluginDependencies =
      let plugin :: Parser Text PluginDependency
plugin = do
            Text
name <- (Char -> Bool) -> Parser Text Text
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') Parser Text Text -> Parser Text Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
A.char Char
':'
            Text
version <- (Char -> Bool) -> Parser Text Text
A.takeWhile1 (\Char
c -> 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
';')
            PluginResolution
resolution <- Parser (Maybe Char)
A.peekChar Parser (Maybe Char)
-> (Maybe Char -> Parser Text PluginResolution)
-> Parser Text PluginResolution
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              -- end of input
              Maybe Char
Nothing -> PluginResolution -> Parser Text PluginResolution
forall (m :: * -> *) a. Monad m => a -> m a
return PluginResolution
Mandatory
              -- next dependency
              Just Char
',' -> Char -> Parser Text Char
A.char Char
',' Parser Text Char
-> Parser Text PluginResolution -> Parser Text PluginResolution
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PluginResolution -> Parser Text PluginResolution
forall (m :: * -> *) a. Monad m => a -> m a
return PluginResolution
Mandatory
              -- specifier
              Just Char
';' -> do
                Text
_ <- Text -> Parser Text Text
A.string Text
";resolution:="
                (Char -> Bool) -> Parser Text Text
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') Parser Text Text
-> (Text -> Parser Text PluginResolution)
-> Parser Text PluginResolution
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Text
"optional" -> PluginResolution -> Parser Text PluginResolution
forall (m :: * -> *) a. Monad m => a -> m a
return PluginResolution
Optional
                  Text
res' -> String -> Parser Text PluginResolution
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text PluginResolution)
-> String -> Parser Text PluginResolution
forall a b. (a -> b) -> a -> b
$ String
"Don't know how to parse resolution: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
res'
              Just Char
c -> String -> Parser Text PluginResolution
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text PluginResolution)
-> String -> Parser Text PluginResolution
forall a b. (a -> b) -> a -> b
$ String
"plugin: expected , or ; but got: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
c]

            -- Consume trailing comma if any
            Parser Text Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Text Char
A.char Char
',') Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser Text ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            PluginDependency -> Parser Text PluginDependency
forall (m :: * -> *) a. Monad m => a -> m a
return (PluginDependency -> Parser Text PluginDependency)
-> PluginDependency -> Parser Text PluginDependency
forall a b. (a -> b) -> a -> b
$! PluginDependency :: PluginResolution -> Text -> Text -> PluginDependency
PluginDependency
              { plugin_dependency_name :: Text
plugin_dependency_name = Text
name
              , plugin_dependency_version :: Text
plugin_dependency_version = Text
version
              , plugin_dependency_resolution :: PluginResolution
plugin_dependency_resolution = PluginResolution
resolution
              }
      in [PluginDependency] -> Set PluginDependency
forall a. Ord a => [a] -> Set a
Set.fromList ([PluginDependency] -> Set PluginDependency)
-> Parser Text [PluginDependency] -> Parser (Set PluginDependency)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text PluginDependency -> Parser Text [PluginDependency]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text PluginDependency
plugin

    -- Lines in manifest can span multiple file lines as long as they
    -- are indented with a space on next physical line.
    kvEntry :: A.Parser (Text, Text)
    kvEntry :: Parser (Text, Text)
kvEntry = do
      Text
key <- (Char -> Bool) -> Parser Text Text
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':')
      Parser Text Char
A.anyChar Parser Text Char -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
A.skipSpace
      let restOfLine :: Parser Text Text
restOfLine = (Char -> Bool) -> Parser Text Text
A.takeTill Char -> Bool
A.isEndOfLine Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
A.endOfLine Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser Text ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          indentedLine :: Parser Text Text
indentedLine = Parser Text Char
A.peekChar' Parser Text Char -> (Char -> Parser Text Text) -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Char
' ' -> Parser Text ()
A.skipSpace Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
restOfLine
            Char
_ -> String -> Parser Text Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"indentedLine doesn't start with a space"

      [Text]
valueLines <- (:) (Text -> [Text] -> [Text])
-> Parser Text Text -> Parser Text ([Text] -> [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
restOfLine Parser Text ([Text] -> [Text])
-> Parser Text [Text] -> Parser Text [Text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text Text
indentedLine
      (Text, Text) -> Parser (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Text) -> Parser (Text, Text))
-> (Text, Text) -> Parser (Text, Text)
forall a b. (a -> b) -> a -> b
$! (Text
key, [Text] -> Text
Text.concat [Text]
valueLines)

    kvMap :: A.Parser (Map Text Text)
    kvMap :: Parser (Map Text Text)
kvMap = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> Parser Text [(Text, Text)] -> Parser (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, Text) -> Parser Text [(Text, Text)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Text, Text)
kvEntry