{-# LANGUAGE TupleSections #-}

-- | Internal Env machinery exposed for testing
module Freckle.App.Env.Internal
  ( Error(..)
  , Parser(..)
  , bindParser
  , Reader(..)
  , Mod(..)
  , Var(..)
  , varParser
  ) where

import Freckle.App.Prelude

import Control.Applicative

-- | Environment parsing errors
data Error
  = UnsetError
  -- ^ A variable was not found, and no default was specified
  | InvalidError String
  -- ^ A variable was found, but it failed to parse
  deriving stock (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

isUnsetError :: Error -> Bool
isUnsetError :: Error -> Bool
isUnsetError Error
UnsetError = Bool
True
isUnsetError (InvalidError String
_) = Bool
False

-- | Parse an Environment
--
-- Errors are accumulated into tuples mapping name to error.
--
newtype Parser a = Parser
  { Parser a -> [(String, String)] -> Either [(String, Error)] a
unParser :: [(String, String)] -> Either [(String, Error)] a
  }
  deriving stock a -> Parser b -> Parser a
(a -> b) -> Parser a -> Parser b
(forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parser b -> Parser a
$c<$ :: forall a b. a -> Parser b -> Parser a
fmap :: (a -> b) -> Parser a -> Parser b
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
Functor

instance Applicative Parser where
  pure :: a -> Parser a
pure a
a = ([(String, String)] -> Either [(String, Error)] a) -> Parser a
forall a.
([(String, String)] -> Either [(String, Error)] a) -> Parser a
Parser (([(String, String)] -> Either [(String, Error)] a) -> Parser a)
-> (Either [(String, Error)] a
    -> [(String, String)] -> Either [(String, Error)] a)
-> Either [(String, Error)] a
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either [(String, Error)] a
-> [(String, String)] -> Either [(String, Error)] a
forall a b. a -> b -> a
const (Either [(String, Error)] a -> Parser a)
-> Either [(String, Error)] a -> Parser a
forall a b. (a -> b) -> a -> b
$ a -> Either [(String, Error)] a
forall a b. b -> Either a b
Right a
a
  Parser [(String, String)] -> Either [(String, Error)] (a -> b)
f <*> :: Parser (a -> b) -> Parser a -> Parser b
<*> Parser [(String, String)] -> Either [(String, Error)] a
a = ([(String, String)] -> Either [(String, Error)] b) -> Parser b
forall a.
([(String, String)] -> Either [(String, Error)] a) -> Parser a
Parser (([(String, String)] -> Either [(String, Error)] b) -> Parser b)
-> ([(String, String)] -> Either [(String, Error)] b) -> Parser b
forall a b. (a -> b) -> a -> b
$ \[(String, String)]
env -> case ([(String, String)] -> Either [(String, Error)] (a -> b)
f [(String, String)]
env, [(String, String)] -> Either [(String, Error)] a
a [(String, String)]
env) of
    (Right a -> b
f', Right a
a') -> b -> Either [(String, Error)] b
forall a b. b -> Either a b
Right (b -> Either [(String, Error)] b)
-> b -> Either [(String, Error)] b
forall a b. (a -> b) -> a -> b
$ a -> b
f' a
a'

    -- Accumulate errors
    (Left [(String, Error)]
e1, Left [(String, Error)]
e2) -> [(String, Error)] -> Either [(String, Error)] b
forall a b. a -> Either a b
Left ([(String, Error)] -> Either [(String, Error)] b)
-> [(String, Error)] -> Either [(String, Error)] b
forall a b. (a -> b) -> a -> b
$ [(String, Error)]
e1 [(String, Error)] -> [(String, Error)] -> [(String, Error)]
forall a. [a] -> [a] -> [a]
++ [(String, Error)]
e2
    (Left [(String, Error)]
e, Either [(String, Error)] a
_) -> [(String, Error)] -> Either [(String, Error)] b
forall a b. a -> Either a b
Left [(String, Error)]
e
    (Either [(String, Error)] (a -> b)
_, Left [(String, Error)]
e) -> [(String, Error)] -> Either [(String, Error)] b
forall a b. a -> Either a b
Left [(String, Error)]
e

instance Alternative Parser where
  empty :: Parser a
empty = ([(String, String)] -> Either [(String, Error)] a) -> Parser a
forall a.
([(String, String)] -> Either [(String, Error)] a) -> Parser a
Parser (([(String, String)] -> Either [(String, Error)] a) -> Parser a)
-> ([(String, String)] -> Either [(String, Error)] a) -> Parser a
forall a b. (a -> b) -> a -> b
$ Either [(String, Error)] a
-> [(String, String)] -> Either [(String, Error)] a
forall a b. a -> b -> a
const (Either [(String, Error)] a
 -> [(String, String)] -> Either [(String, Error)] a)
-> Either [(String, Error)] a
-> [(String, String)]
-> Either [(String, Error)] a
forall a b. (a -> b) -> a -> b
$ [(String, Error)] -> Either [(String, Error)] a
forall a b. a -> Either a b
Left []
  Parser [(String, String)] -> Either [(String, Error)] a
f <|> :: Parser a -> Parser a -> Parser a
<|> Parser [(String, String)] -> Either [(String, Error)] a
g = ([(String, String)] -> Either [(String, Error)] a) -> Parser a
forall a.
([(String, String)] -> Either [(String, Error)] a) -> Parser a
Parser (([(String, String)] -> Either [(String, Error)] a) -> Parser a)
-> ([(String, String)] -> Either [(String, Error)] a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \[(String, String)]
env -> case [(String, String)] -> Either [(String, Error)] a
f [(String, String)]
env of
    Left [(String, Error)]
ferrs | ((String, Error) -> Bool) -> [(String, Error)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Error -> Bool
isUnsetError (Error -> Bool)
-> ((String, Error) -> Error) -> (String, Error) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Error) -> Error
forall a b. (a, b) -> b
snd) [(String, Error)]
ferrs -> case [(String, String)] -> Either [(String, Error)] a
g [(String, String)]
env of
      Left [(String, Error)]
gerrs -> [(String, Error)] -> Either [(String, Error)] a
forall a b. a -> Either a b
Left ([(String, Error)]
ferrs [(String, Error)] -> [(String, Error)] -> [(String, Error)]
forall a. [a] -> [a] -> [a]
++ [(String, Error)]
gerrs)
      Either [(String, Error)] a
y -> Either [(String, Error)] a
y
    Either [(String, Error)] a
x -> Either [(String, Error)] a
x

-- | Monadic bind for @'Parser'@
--
-- This short-circuits all parsing and is not ideal for an applicative style
-- parser, which ideally reports all errors instead of short-circuiting. As such
-- a `Monad` instance is not exposed for @'Parser'@.
--
bindParser :: Parser a -> (a -> Parser b) -> Parser b
bindParser :: Parser a -> (a -> Parser b) -> Parser b
bindParser (Parser [(String, String)] -> Either [(String, Error)] a
f) a -> Parser b
g = ([(String, String)] -> Either [(String, Error)] b) -> Parser b
forall a.
([(String, String)] -> Either [(String, Error)] a) -> Parser a
Parser (([(String, String)] -> Either [(String, Error)] b) -> Parser b)
-> ([(String, String)] -> Either [(String, Error)] b) -> Parser b
forall a b. (a -> b) -> a -> b
$ \[(String, String)]
envs -> do
  a
x <- [(String, String)] -> Either [(String, Error)] a
f [(String, String)]
envs
  let h :: [(String, String)] -> Either [(String, Error)] b
h = Parser b -> [(String, String)] -> Either [(String, Error)] b
forall a.
Parser a -> [(String, String)] -> Either [(String, Error)] a
unParser (Parser b -> [(String, String)] -> Either [(String, Error)] b)
-> Parser b -> [(String, String)] -> Either [(String, Error)] b
forall a b. (a -> b) -> a -> b
$ a -> Parser b
g a
x
  [(String, String)] -> Either [(String, Error)] b
h [(String, String)]
envs

-- | Read a single environment variable's value
--
-- This will only ever fail with @'InvalidError'@, since @'UnsetError'@ is
-- handled before invoking any @'Reader'@.
--
newtype Reader a = Reader
  { Reader a -> String -> Either Error a
unReader :: String -> Either Error a
  }
  deriving stock (a -> Reader b -> Reader a
(a -> b) -> Reader a -> Reader b
(forall a b. (a -> b) -> Reader a -> Reader b)
-> (forall a b. a -> Reader b -> Reader a) -> Functor Reader
forall a b. a -> Reader b -> Reader a
forall a b. (a -> b) -> Reader a -> Reader b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Reader b -> Reader a
$c<$ :: forall a b. a -> Reader b -> Reader a
fmap :: (a -> b) -> Reader a -> Reader b
$cfmap :: forall a b. (a -> b) -> Reader a -> Reader b
Functor)

newtype Mod a = Mod (Var a -> Var a)

instance Semigroup (Mod a) where
  Mod Var a -> Var a
f <> :: Mod a -> Mod a -> Mod a
<> Mod Var a -> Var a
g = (Var a -> Var a) -> Mod a
forall a. (Var a -> Var a) -> Mod a
Mod ((Var a -> Var a) -> Mod a) -> (Var a -> Var a) -> Mod a
forall a b. (a -> b) -> a -> b
$ Var a -> Var a
f (Var a -> Var a) -> (Var a -> Var a) -> Var a -> Var a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var a -> Var a
g

instance Monoid (Mod a) where
  mempty :: Mod a
mempty = (Var a -> Var a) -> Mod a
forall a. (Var a -> Var a) -> Mod a
Mod Var a -> Var a
forall a. a -> a
id

data Var a = Var
  { Var a -> String
varName :: String
  , Var a -> Reader a
varReader :: Reader a
  , Var a -> Maybe a
varDefault :: Maybe a
  }

varParser :: Var a -> Parser a
varParser :: Var a -> Parser a
varParser Var {String
Maybe a
Reader a
varDefault :: Maybe a
varReader :: Reader a
varName :: String
varDefault :: forall a. Var a -> Maybe a
varReader :: forall a. Var a -> Reader a
varName :: forall a. Var a -> String
..} = ([(String, String)] -> Either [(String, Error)] a) -> Parser a
forall a.
([(String, String)] -> Either [(String, Error)] a) -> Parser a
Parser (([(String, String)] -> Either [(String, Error)] a) -> Parser a)
-> ([(String, String)] -> Either [(String, Error)] a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \[(String, String)]
env -> case (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
varName [(String, String)]
env, Maybe a
varDefault) of
  (Maybe String
Nothing, Just a
d) -> a -> Either [(String, Error)] a
forall a b. b -> Either a b
Right a
d
  (Maybe String
Nothing, Maybe a
_) -> [(String, Error)] -> Either [(String, Error)] a
forall a b. a -> Either a b
Left [(String
varName, Error
UnsetError)]
  (Just String
v, Maybe a
_) -> (Error -> [(String, Error)])
-> Either Error a -> Either [(String, Error)] a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((String, Error) -> [(String, Error)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String, Error) -> [(String, Error)])
-> (Error -> (String, Error)) -> Error -> [(String, Error)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
varName, )) (Either Error a -> Either [(String, Error)] a)
-> Either Error a -> Either [(String, Error)] a
forall a b. (a -> b) -> a -> b
$ Reader a -> String -> Either Error a
forall a. Reader a -> String -> Either Error a
unReader Reader a
varReader String
v