{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module OptEnvConf.Nix where

import Autodocodec
import Autodocodec.Nix
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Map (Map)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import OptEnvConf.Parser
import OptEnvConf.Setting

renderSettingsNixOptions :: forall a. (HasParser a) => Text
renderSettingsNixOptions :: forall a. HasParser a => Text
renderSettingsNixOptions = Parser a -> Text
forall a. Parser a -> Text
renderParserNixOptions (Parser a
forall a. HasParser a => Parser a
settingsParser :: Parser a)

renderParserNixOptions :: Parser a -> Text
renderParserNixOptions :: forall a. Parser a -> Text
renderParserNixOptions = Expr -> Text
renderExpr (Expr -> Text) -> (Parser a -> Expr) -> Parser a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Expr
forall a. Parser a -> Expr
parserNixOptionExpr

parserNixOptionExpr :: Parser a -> Expr
parserNixOptionExpr :: forall a. Parser a -> Expr
parserNixOptionExpr = Expr -> Expr
withNixArgs (Expr -> Expr) -> (Parser a -> Expr) -> Parser a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Option -> Expr
optionsExpr (Map Text Option -> Expr)
-> (Parser a -> Map Text Option) -> Parser a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Map Text Option
forall a. Parser a -> Map Text Option
parserNixOptions

parserNixOptions :: Parser a -> Map Text Option
parserNixOptions :: forall a. Parser a -> Map Text Option
parserNixOptions = Parser a -> Map Text Option
forall a. Parser a -> Map Text Option
go
  where
    go :: Parser a -> Map Text Option
    go :: forall a. Parser a -> Map Text Option
go = \case
      ParserPure a
_ -> Map Text Option
forall k a. Map k a
M.empty
      ParserAp Parser (a1 -> a)
p1 Parser a1
p2 -> (Option -> Option -> Option)
-> Map Text Option -> Map Text Option -> Map Text Option
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Option -> Option -> Option
combineOption (Parser (a1 -> a) -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser (a1 -> a)
p1) (Parser a1 -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser a1
p2)
      ParserSelect Parser (Either a1 a)
p1 Parser (a1 -> a)
p2 -> (Option -> Option -> Option)
-> Map Text Option -> Map Text Option -> Map Text Option
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Option -> Option -> Option
combineOption (Parser (Either a1 a) -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser (Either a1 a)
p1) (Parser (a1 -> a) -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser (a1 -> a)
p2)
      ParserEmpty Maybe SrcLoc
_ -> Map Text Option
forall k a. Map k a
M.empty
      ParserAlt Parser a
p1 Parser a
p2 -> (Option -> Option -> Option)
-> Map Text Option -> Map Text Option -> Map Text Option
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Option -> Option -> Option
combineOption (Parser a -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser a
p1) (Parser a -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser a
p2) -- TODO is this right?
      ParserMany Parser a1
p -> Parser a1 -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser a1
p
      ParserSome Parser a1
p -> Parser a1 -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser a1
p
      ParserAllOrNothing Maybe SrcLoc
_ Parser a
p -> Parser a -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser a
p
      ParserCheck Maybe SrcLoc
_ Bool
_ a1 -> IO (Either String a)
_ Parser a1
p -> Parser a1 -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser a1
p
      ParserCommands Maybe SrcLoc
_ Maybe String
_ [Command a]
cs -> (Option -> Option -> Option)
-> [Map Text Option] -> Map Text Option
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith Option -> Option -> Option
combineOption ([Map Text Option] -> Map Text Option)
-> [Map Text Option] -> Map Text Option
forall a b. (a -> b) -> a -> b
$ (Command a -> Map Text Option) -> [Command a] -> [Map Text Option]
forall a b. (a -> b) -> [a] -> [b]
map Command a -> Map Text Option
forall a. Command a -> Map Text Option
goCommand [Command a]
cs
      ParserWithConfig Maybe SrcLoc
_ Parser (Maybe Object)
p1 Parser a
p2 ->
        -- I'm not sure if we need the first as well because you wouldn't use a
        -- config to load a config but it's technically possible so let's
        -- support it.
        (Option -> Option -> Option)
-> Map Text Option -> Map Text Option -> Map Text Option
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Option -> Option -> Option
combineOption (Parser (Maybe Object) -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser (Maybe Object)
p1) (Parser a -> Map Text Option
forall a. Parser a -> Map Text Option
go Parser a
p2)
      ParserSetting Maybe SrcLoc
_ Setting a
s ->
        let codecTups :: [ConfigValSetting a]
codecTups = [ConfigValSetting a]
-> (NonEmpty (ConfigValSetting a) -> [ConfigValSetting a])
-> Maybe (NonEmpty (ConfigValSetting a))
-> [ConfigValSetting a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty (ConfigValSetting a) -> [ConfigValSetting a]
forall a. NonEmpty a -> [a]
NE.toList (Setting a -> Maybe (NonEmpty (ConfigValSetting a))
forall a. Setting a -> Maybe (NonEmpty (ConfigValSetting a))
settingConfigVals Setting a
s)
         in (Option -> Option -> Option)
-> [Map Text Option] -> Map Text Option
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith Option -> Option -> Option
combineOption ([Map Text Option] -> Map Text Option)
-> [Map Text Option] -> Map Text Option
forall a b. (a -> b) -> a -> b
$ ((ConfigValSetting a -> Map Text Option)
 -> [ConfigValSetting a] -> [Map Text Option])
-> [ConfigValSetting a]
-> (ConfigValSetting a -> Map Text Option)
-> [Map Text Option]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ConfigValSetting a -> Map Text Option)
-> [ConfigValSetting a] -> [Map Text Option]
forall a b. (a -> b) -> [a] -> [b]
map [ConfigValSetting a]
codecTups ((ConfigValSetting a -> Map Text Option) -> [Map Text Option])
-> (ConfigValSetting a -> Map Text Option) -> [Map Text Option]
forall a b. (a -> b) -> a -> b
$ \ConfigValSetting {NonEmpty String
ValueCodec void (Maybe a)
configValSettingPath :: NonEmpty String
configValSettingCodec :: ValueCodec void (Maybe a)
configValSettingPath :: forall a. ConfigValSetting a -> NonEmpty String
configValSettingCodec :: ()
..} ->
              let go' :: NonEmpty Text -> Map Text Option
                  go' :: NonEmpty Text -> Map Text Option
go' (Text
p :| [Text]
ps) = case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
ps of
                    Maybe (NonEmpty Text)
Nothing ->
                      let oc :: ObjectCodec (Maybe void) (Maybe (Maybe a))
oc =
                            ObjectCodec (Maybe void) (Maybe (Maybe a))
-> (Text -> ObjectCodec (Maybe void) (Maybe (Maybe a)))
-> Maybe Text
-> ObjectCodec (Maybe void) (Maybe (Maybe a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                              (Text
-> ValueCodec void (Maybe a)
-> ObjectCodec (Maybe void) (Maybe (Maybe a))
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
p ValueCodec void (Maybe a)
configValSettingCodec)
                              (Text
-> ValueCodec void (Maybe a)
-> Text
-> ObjectCodec (Maybe void) (Maybe (Maybe a))
forall input output.
Text
-> ValueCodec input output
-> Text
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith Text
p ValueCodec void (Maybe a)
configValSettingCodec)
                              (String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Setting a -> Maybe String
forall a. Setting a -> Maybe String
settingHelp Setting a
s)
                       in ObjectCodec (Maybe void) (Maybe (Maybe a)) -> Map Text Option
forall input output. ObjectCodec input output -> Map Text Option
objectCodecNixOptions ObjectCodec (Maybe void) (Maybe (Maybe a))
oc
                    Just NonEmpty Text
rest ->
                      let m :: Map Text Option
m = NonEmpty Text -> Map Text Option
go' NonEmpty Text
rest
                       in Text -> Option -> Map Text Option
forall k a. k -> a -> Map k a
M.singleton Text
p (Option -> Map Text Option) -> Option -> Map Text Option
forall a b. (a -> b) -> a -> b
$ Option
emptyOption {optionType = Just (OptionTypeSubmodule m)}
               in NonEmpty Text -> Map Text Option
go' (NonEmpty Text -> Map Text Option)
-> NonEmpty Text -> Map Text Option
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> NonEmpty String -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map String -> Text
T.pack NonEmpty String
configValSettingPath
    combineOption :: Option -> Option -> Option
    combineOption :: Option -> Option -> Option
combineOption Option
o1 Option
o2 = case (Option -> Maybe OptionType
optionType Option
o1, Option -> Maybe OptionType
optionType Option
o2) of
      (Maybe OptionType
Nothing, Maybe OptionType
_) -> Option
o2
      (Just OptionType
ot1, Maybe OptionType
Nothing) -> Option
o2 {optionType = Just ot1}
      (Just OptionType
ot1, Just OptionType
ot2) -> Option
o2 {optionType = Just $ combineOptionType ot1 ot2}

    combineOptionType :: OptionType -> OptionType -> OptionType
    combineOptionType :: OptionType -> OptionType -> OptionType
combineOptionType OptionType
ot1 OptionType
ot2 = OptionType -> OptionType
simplifyOptionType (OptionType -> OptionType) -> OptionType -> OptionType
forall a b. (a -> b) -> a -> b
$ case (OptionType
ot1, OptionType
ot2) of
      (OptionTypeSubmodule Map Text Option
m1, OptionTypeSubmodule Map Text Option
m2) -> Map Text Option -> OptionType
OptionTypeSubmodule (Map Text Option -> OptionType) -> Map Text Option -> OptionType
forall a b. (a -> b) -> a -> b
$ (Option -> Option -> Option)
-> Map Text Option -> Map Text Option -> Map Text Option
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Option -> Option -> Option
combineOption Map Text Option
m1 Map Text Option
m2
      (OptionType, OptionType)
_ -> [OptionType] -> OptionType
OptionTypeOneOf [OptionType
ot1, OptionType
ot2]
    goCommand :: Command a -> Map Text Option
    goCommand :: forall a. Command a -> Map Text Option
goCommand = Parser a -> Map Text Option
forall a. Parser a -> Map Text Option
go (Parser a -> Map Text Option)
-> (Command a -> Parser a) -> Command a -> Map Text Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command a -> Parser a
forall a. Command a -> Parser a
commandParser