{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

module OptEnvConf.Reader
  ( Reader (..),

    -- * Common readers
    str,
    auto,
    exists,
    viaStringCodec,

    -- * Constructing your own reader
    maybeReader,
    eitherReader,

    -- * Comma-separated readers
    commaSeparated,
    commaSeparatedList,
    commaSeparatedSet,

    -- * Internal
    runReader,
    renderCommaSeparated,
    parseCommaSeparated,
  )
where

import Autodocodec
import Data.Aeson.Types as JSON
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Set (Set)
import qualified Data.Set as S
import Data.String
import qualified Data.Text as T
import Text.Read (readMaybe)

newtype Reader a = Reader {forall a. Reader a -> [Char] -> Either [Char] a
unReader :: String -> Either String a}
  deriving ((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
$cfmap :: forall a b. (a -> b) -> Reader a -> Reader b
fmap :: forall a b. (a -> b) -> Reader a -> Reader b
$c<$ :: forall a b. a -> Reader b -> Reader a
<$ :: forall a b. a -> Reader b -> Reader a
Functor)

runReader :: Reader a -> String -> Either String a
runReader :: forall a. Reader a -> [Char] -> Either [Char] a
runReader = Reader a -> [Char] -> Either [Char] a
forall a. Reader a -> [Char] -> Either [Char] a
unReader

-- | Read a string as-is.
--
-- __This is the reader you will want to use for reading a 'String'.__
--
-- This is different from 'auto' for strings because 'Read' wants to parse quotes when parsing Strings.
str :: (IsString s) => Reader s
str :: forall s. IsString s => Reader s
str = ([Char] -> Either [Char] s) -> Reader s
forall a. ([Char] -> Either [Char] a) -> Reader a
Reader (([Char] -> Either [Char] s) -> Reader s)
-> ([Char] -> Either [Char] s) -> Reader s
forall a b. (a -> b) -> a -> b
$ s -> Either [Char] s
forall a b. b -> Either a b
Right (s -> Either [Char] s)
-> ([Char] -> s) -> [Char] -> Either [Char] s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> s
forall a. IsString a => [Char] -> a
fromString

-- | Read via the 'Read' instance
--
-- You cannot use this for bare strings, because 'Read' for strings parses quotes.
auto :: (Read a) => Reader a
auto :: forall a. Read a => Reader a
auto = ([Char] -> Either [Char] a) -> Reader a
forall a. ([Char] -> Either [Char] a) -> Reader a
Reader (([Char] -> Either [Char] a) -> Reader a)
-> ([Char] -> Either [Char] a) -> Reader a
forall a b. (a -> b) -> a -> b
$ \[Char]
s -> case [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s of
  Maybe a
Nothing -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([Char] -> Either [Char] a) -> [Char] -> Either [Char] a
forall a b. (a -> b) -> a -> b
$ [Char]
"Un-Read-able value: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s
  Just a
a -> a -> Either [Char] a
forall a b. b -> Either a b
Right a
a

-- | Always return True
--
-- > exists = Reader $ const $ pure True
exists :: Reader Bool
exists :: Reader Bool
exists = ([Char] -> Either [Char] Bool) -> Reader Bool
forall a. ([Char] -> Either [Char] a) -> Reader a
Reader (([Char] -> Either [Char] Bool) -> Reader Bool)
-> ([Char] -> Either [Char] Bool) -> Reader Bool
forall a b. (a -> b) -> a -> b
$ Either [Char] Bool -> [Char] -> Either [Char] Bool
forall a b. a -> b -> a
const (Either [Char] Bool -> [Char] -> Either [Char] Bool)
-> Either [Char] Bool -> [Char] -> Either [Char] Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either [Char] Bool
forall a. a -> Either [Char] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

-- | Read a value as if it were specified as a 'String' and parsed via the given 'Codec'.
viaStringCodec :: (HasCodec a) => Reader a
viaStringCodec :: forall a. HasCodec a => Reader a
viaStringCodec = ([Char] -> Either [Char] a) -> Reader a
forall a. ([Char] -> Either [Char] a) -> Reader a
eitherReader (([Char] -> Either [Char] a) -> Reader a)
-> ([Char] -> Either [Char] a) -> Reader a
forall a b. (a -> b) -> a -> b
$ ([Char] -> Parser a) -> [Char] -> Either [Char] a
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither (([Char] -> Parser a) -> [Char] -> Either [Char] a)
-> ([Char] -> Parser a) -> [Char] -> Either [Char] a
forall a b. (a -> b) -> a -> b
$ Value -> Parser a
forall a. HasCodec a => Value -> Parser a
parseJSONViaCodec (Value -> Parser a) -> ([Char] -> Value) -> [Char] -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
JSON.String (Text -> Value) -> ([Char] -> Text) -> [Char] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

-- | Turn a 'Maybe' parsing function into a 'Reader'
maybeReader :: (String -> Maybe a) -> Reader a
maybeReader :: forall a. ([Char] -> Maybe a) -> Reader a
maybeReader [Char] -> Maybe a
func = ([Char] -> Either [Char] a) -> Reader a
forall a. ([Char] -> Either [Char] a) -> Reader a
eitherReader (([Char] -> Either [Char] a) -> Reader a)
-> ([Char] -> Either [Char] a) -> Reader a
forall a b. (a -> b) -> a -> b
$ \[Char]
s -> case [Char] -> Maybe a
func [Char]
s of
  Maybe a
Nothing -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([Char] -> Either [Char] a) -> [Char] -> Either [Char] a
forall a b. (a -> b) -> a -> b
$ [Char]
"Unparseable value: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s
  Just a
a -> a -> Either [Char] a
forall a b. b -> Either a b
Right a
a

-- | Turn an 'Either' parsing function into a 'Reader'
--
-- API note: This is a forward-compatible alias for 'Reader'.
eitherReader :: (String -> Either String a) -> Reader a
eitherReader :: forall a. ([Char] -> Either [Char] a) -> Reader a
eitherReader = ([Char] -> Either [Char] a) -> Reader a
forall a. ([Char] -> Either [Char] a) -> Reader a
Reader

-- | Like 'commaSeparated' but uses a set type.
--
-- Note that this will never parse the empty list, so prefer 'commaSeparated'
-- if you want a more accurately typed function.
--
-- Note also that this function throws away any ordering information and
-- ignores any duplicate values.
commaSeparatedSet :: (Ord a) => Reader a -> Reader (Set a)
commaSeparatedSet :: forall a. Ord a => Reader a -> Reader (Set a)
commaSeparatedSet Reader a
func = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> Reader [a] -> Reader (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader a -> Reader [a]
forall a. Reader a -> Reader [a]
commaSeparatedList Reader a
func

-- | Like 'commaSeparated' but uses a list type.
--
-- Note that this will never parse the empty list, so prefer 'commaSeparated'
-- if you want a more accurately typed function.
commaSeparatedList :: Reader a -> Reader [a]
commaSeparatedList :: forall a. Reader a -> Reader [a]
commaSeparatedList Reader a
func = NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty a -> [a]) -> Reader (NonEmpty a) -> Reader [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader a -> Reader (NonEmpty a)
forall a. Reader a -> Reader (NonEmpty a)
commaSeparated Reader a
func

-- | Turn a reader into one that parses comma separated values with that reader.
commaSeparated :: Reader a -> Reader (NonEmpty a)
commaSeparated :: forall a. Reader a -> Reader (NonEmpty a)
commaSeparated (Reader [Char] -> Either [Char] a
func) = ([Char] -> Either [Char] (NonEmpty a)) -> Reader (NonEmpty a)
forall a. ([Char] -> Either [Char] a) -> Reader a
Reader (([Char] -> Either [Char] (NonEmpty a)) -> Reader (NonEmpty a))
-> ([Char] -> Either [Char] (NonEmpty a)) -> Reader (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ ([Char] -> Either [Char] a)
-> NonEmpty [Char] -> Either [Char] (NonEmpty a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM [Char] -> Either [Char] a
func (NonEmpty [Char] -> Either [Char] (NonEmpty a))
-> ([Char] -> NonEmpty [Char])
-> [Char]
-> Either [Char] (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> NonEmpty [Char]
parseCommaSeparated

-- | Separate by commas and escape commas in values
renderCommaSeparated :: NonEmpty String -> String
renderCommaSeparated :: NonEmpty [Char] -> [Char]
renderCommaSeparated = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]] -> [Char])
-> (NonEmpty [Char] -> [[Char]]) -> NonEmpty [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
escape ([[Char]] -> [[Char]])
-> (NonEmpty [Char] -> [[Char]]) -> NonEmpty [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty [Char] -> [[Char]]
forall a. NonEmpty a -> [a]
NE.toList
  where
    escape :: [Char] -> [Char]
escape = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char -> [Char]) -> [Char] -> [Char])
-> (Char -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ \case
      Char
',' -> [Char]
"\\,"
      Char
'\\' -> [Char]
"\\\\"
      Char
c -> [Char
c]

-- | Parse comma separated string, ignore escaped commas
parseCommaSeparated :: String -> NonEmpty String
parseCommaSeparated :: [Char] -> NonEmpty [Char]
parseCommaSeparated = [Char] -> [Char] -> NonEmpty [Char]
go [Char]
""
  where
    go :: [Char] -> [Char] -> NonEmpty [Char]
go [Char]
acc = \case
      [] -> [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
acc [Char] -> [[Char]] -> NonEmpty [Char]
forall a. a -> [a] -> NonEmpty a
:| []
      Char
'\\' : Char
'\\' : [Char]
rest -> [Char] -> [Char] -> NonEmpty [Char]
go (Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
acc) [Char]
rest
      Char
'\\' : Char
',' : [Char]
rest -> [Char] -> [Char] -> NonEmpty [Char]
go (Char
',' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
acc) [Char]
rest
      Char
',' : [Char]
rest -> [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
acc [Char] -> NonEmpty [Char] -> NonEmpty [Char]
forall a. a -> NonEmpty a -> NonEmpty a
<| [Char] -> [Char] -> NonEmpty [Char]
go [Char]
"" [Char]
rest
      Char
c : [Char]
rest -> [Char] -> [Char] -> NonEmpty [Char]
go (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
acc) [Char]
rest