module LoadEnv.Parse
    ( Environment
    , Variable
    , parseEnvironment
    , parseVariable
    ) where

import Control.Monad (void)
import Data.Maybe (catMaybes)
import Text.Parsec
import Text.Parsec.String

type Environment = [Variable]
type Variable = (String, String)

parseEnvironment :: Parser Environment
parseEnvironment :: Parser Environment
parseEnvironment = [Maybe Variable] -> Environment
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Variable] -> Environment)
-> ParsecT String () Identity [Maybe Variable]
-> Parser Environment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity (Maybe Variable)
-> ParsecT String () Identity [Maybe Variable]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity (Maybe Variable)
parseLine

parseLine :: Parser (Maybe Variable)
parseLine :: ParsecT String () Identity (Maybe Variable)
parseLine = Parser Variable -> ParsecT String () Identity (Maybe Variable)
forall a. Parser a -> Parser (Maybe a)
possibly Parser Variable
parseVariable

possibly :: Parser a -> Parser (Maybe a)
possibly :: forall a. Parser a -> Parser (Maybe a)
possibly Parser a
p = ParsecT String () Identity (Maybe a)
-> ParsecT String () Identity (Maybe a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> ParsecT String () Identity (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p) ParsecT String () Identity (Maybe a)
-> ParsecT String () Identity (Maybe a)
-> ParsecT String () Identity (Maybe a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity (Maybe a)
forall {u} {a}. ParsecT String u Identity (Maybe a)
ignored

  where
    ignored :: ParsecT String u Identity (Maybe a)
ignored = Maybe a
forall a. Maybe a
Nothing Maybe a
-> ParsecT String u Identity String
-> ParsecT String u Identity (Maybe a)
forall a b.
a -> ParsecT String u Identity b -> ParsecT String u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT String u Identity Char
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String u Identity Char
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

parseVariable :: Parser Variable
parseVariable :: Parser Variable
parseVariable = do
    ParsecT String () Identity String -> ParsecT String () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT String () Identity String
 -> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity ()
-> ParsecT String () Identity ()
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces (ParsecT String () Identity String
 -> ParsecT String () Identity String)
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"export"

    String
i <- ParsecT String () Identity String
identifier
    String
v <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=' ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity String
value

    ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
 -> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
 -> ParsecT String () Identity String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t"
    ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

    Variable -> Parser Variable
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
i, String
v)

-- Environment variable names used by the utilities in the Shell and Utilities
-- volume of POSIX.1-2017 consist solely of uppercase letters, digits,
-- and the <underscore> ( '_' ) from the characters defined in Portable
-- Character Set and do not begin with a digit. Other characters may be
-- permitted by an implementation; applications shall tolerate the presence
-- of such names. Uppercase and lowercase letters shall retain their unique
-- identities and shall not be folded together. The name space of environment
-- variable names containing lowercase letters is reserved for applications.
-- Applications can define any environment variables with names from this name
-- space without modifying the behavior of the standard utilities.
--
-- <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap08.html>
--
identifier :: Parser String
identifier :: ParsecT String () Identity String
identifier = do
    Char
x <- ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lower ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall {u}. ParsecT String u Identity Char
underscore
    String
ys <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
 -> ParsecT String () Identity String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>  ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lower ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall {u}. ParsecT String u Identity Char
underscore

    String -> ParsecT String () Identity String
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
ys)

  where
    underscore :: ParsecT String u Identity Char
underscore = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'

value :: Parser String
value :: ParsecT String () Identity String
value = ParsecT String () Identity String
quotedValue ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity String
unquotedValue ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity String
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""

quotedValue :: Parser String
quotedValue :: ParsecT String () Identity String
quotedValue = do
    Char
q <- String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"'\""

    ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String () Identity Char
escaped Char
q) ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken) (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
q)

unquotedValue :: Parser String
unquotedValue :: ParsecT String () Identity String
unquotedValue = ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char
 -> ParsecT String () Identity String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String () Identity Char
escaped Char
' ') ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\"' \n"

escaped :: Char -> Parser Char
escaped :: Char -> ParsecT String () Identity Char
escaped Char
c = Char
c Char
-> ParsecT String () Identity String
-> ParsecT String () Identity Char
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (String
"\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c])