{-# LANGUAGE TupleSections, OverloadedStrings #-}
{-|
Description: Additional functions that should probably be in @hnix@

Nix generation helpers. No guarantee of stability (internal!).
-}
module Nix.Expr.Additions
( stringKey, ($$=), dynamicKey, inheritStatic
, simpleParamSet, multiParam
, (!!.)
, StrQ(..), mkStrQ, mkStrQI
) where

import Data.Fix (Fix(..))
import Data.Text (Text)
import Data.String (IsString(..))

import Nix.Expr
import Text.Regex.TDFA.Text ()
import Text.Regex.TDFA ((=~))

-- hnix helpers
-- TODO submit upstream

-- | Make a binding, but have the key be a string, not symbol.
stringKey :: Text -> NExpr -> Binding NExpr
stringKey :: Text -> NExpr -> Binding NExpr
stringKey Text
k NExpr
v = NAttrPath NExpr -> NExpr -> SourcePos -> Binding NExpr
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar (NKeyName NExpr -> NAttrPath NExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NKeyName NExpr -> NAttrPath NExpr)
-> NKeyName NExpr -> NAttrPath NExpr
forall a b. (a -> b) -> a -> b
$ Text -> NKeyName NExpr
dynamicKey Text
k) NExpr
v SourcePos
nullPos
-- | Infix version of 'stringKey'.
($$=) :: Text -> NExpr -> Binding NExpr
$$= :: Text -> NExpr -> Binding NExpr
($$=) = Text -> NExpr -> Binding NExpr
stringKey
infixr 2 $$=

-- | Make a dynamic key name that is only enclosed in double quotes (no antiquotes).
dynamicKey :: Text -> NKeyName NExpr
dynamicKey :: Text -> NKeyName NExpr
dynamicKey Text
k = Antiquoted (NString NExpr) NExpr -> NKeyName NExpr
forall r. Antiquoted (NString r) r -> NKeyName r
DynamicKey (Antiquoted (NString NExpr) NExpr -> NKeyName NExpr)
-> Antiquoted (NString NExpr) NExpr -> NKeyName NExpr
forall a b. (a -> b) -> a -> b
$ NString NExpr -> Antiquoted (NString NExpr) NExpr
forall v r. v -> Antiquoted v r
Plain (NString NExpr -> Antiquoted (NString NExpr) NExpr)
-> NString NExpr -> Antiquoted (NString NExpr) NExpr
forall a b. (a -> b) -> a -> b
$ [Antiquoted Text NExpr] -> NString NExpr
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain Text
k]

-- | Inherit the given list of symbols.
inheritStatic :: [Text] -> Binding e
inheritStatic :: [Text] -> Binding e
inheritStatic [Text]
names = [NKeyName e] -> SourcePos -> Binding e
forall e. [NKeyName e] -> SourcePos -> Binding e
inherit ((Text -> NKeyName e) -> [Text] -> [NKeyName e]
forall a b. (a -> b) -> [a] -> [b]
map Text -> NKeyName e
forall r. Text -> NKeyName r
StaticKey [Text]
names) SourcePos
nullPos

-- | shortcut to create a list of closed params, like @{ foo, bar, baz }:@
simpleParamSet :: [Text] -> Params NExpr
simpleParamSet :: [Text] -> Params NExpr
simpleParamSet [Text]
prms = [(Text, Maybe NExpr)] -> Bool -> Params NExpr
mkParamset ((Text -> (Text, Maybe NExpr)) -> [Text] -> [(Text, Maybe NExpr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Maybe NExpr
forall a. Maybe a
Nothing) [Text]
prms) Bool
False

-- | shortcut to create a list of multiple params, like @a: b: c:@
multiParam :: [Text] -> NExpr -> NExpr
multiParam :: [Text] -> NExpr -> NExpr
multiParam [Text]
ps NExpr
expr = (Params NExpr -> NExpr -> NExpr)
-> NExpr -> [Params NExpr] -> NExpr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Params NExpr -> NExpr -> NExpr
mkFunction NExpr
expr ([Params NExpr] -> NExpr) -> [Params NExpr] -> NExpr
forall a b. (a -> b) -> a -> b
$ (Text -> Params NExpr) -> [Text] -> [Params NExpr]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Params NExpr
forall r. Text -> Params r
Param [Text]
ps

-- TODO: switch over to !. when
-- https://github.com/jwiegley/hnix/commit/8b4c137a3b125f52bb78039a9d201492032b38e8
-- goes upstream
-- | Like '!.', but automatically convert plain strings to static keys.
(!!.) :: NExpr -> Text -> NExpr
NExpr
aset !!. :: NExpr -> Text -> NExpr
!!. Text
k = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
  (NExprF NExpr -> NExpr) -> NExprF NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ NExpr -> NAttrPath NExpr -> Maybe NExpr -> NExprF NExpr
forall r. r -> NAttrPath r -> Maybe r -> NExprF r
NSelect NExpr
aset
      (NKeyName NExpr -> NAttrPath NExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NKeyName NExpr -> NAttrPath NExpr)
-> NKeyName NExpr -> NAttrPath NExpr
forall a b. (a -> b) -> a -> b
$ (if Text -> Bool
isPlainSymbol Text
k then Text -> NKeyName NExpr
forall r. Text -> NKeyName r
StaticKey else Text -> NKeyName NExpr
dynamicKey) Text
k) Maybe NExpr
forall a. Maybe a
Nothing
  where
    -- the nix lexer regex for IDs (symbols) is 
    -- [a-zA-Z\_][a-zA-Z0-9\_\'\-]*
    isPlainSymbol :: Text -> Bool
    isPlainSymbol :: Text -> Bool
isPlainSymbol Text
s = Text
s Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (Text
"^[a-zA-Z_][a-zA-Z0-9_'-]*$" :: Text)
infixl 8 !!.


-- | String quotation, either a plain string (S) or antiquoted (A)
data StrQ = StrQ !Text | AntiQ !NExpr
instance IsString StrQ where
  fromString :: String -> StrQ
fromString = Text -> StrQ
StrQ (Text -> StrQ) -> (String -> Text) -> String -> StrQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- 
mkStrQtmpl :: ([Antiquoted Text NExpr] -> NString NExpr) -> [StrQ] -> NExpr
mkStrQtmpl :: ([Antiquoted Text NExpr] -> NString NExpr) -> [StrQ] -> NExpr
mkStrQtmpl [Antiquoted Text NExpr] -> NString NExpr
strtr = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr)
-> ([StrQ] -> NExprF NExpr) -> [StrQ] -> NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NString NExpr -> NExprF NExpr
forall r. NString r -> NExprF r
NStr (NString NExpr -> NExprF NExpr)
-> ([StrQ] -> NString NExpr) -> [StrQ] -> NExprF NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Antiquoted Text NExpr] -> NString NExpr
strtr ([Antiquoted Text NExpr] -> NString NExpr)
-> ([StrQ] -> [Antiquoted Text NExpr]) -> [StrQ] -> NString NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrQ -> Antiquoted Text NExpr)
-> [StrQ] -> [Antiquoted Text NExpr]
forall a b. (a -> b) -> [a] -> [b]
map StrQ -> Antiquoted Text NExpr
trans
  where trans :: StrQ -> Antiquoted Text NExpr
trans (StrQ Text
t) = Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain Text
t
        trans (AntiQ NExpr
r) = NExpr -> Antiquoted Text NExpr
forall v r. r -> Antiquoted v r
Antiquoted NExpr
r

mkStrQ, mkStrQI :: [StrQ] -> NExpr
-- | Create a double-quoted string from a list of antiquotes/plain strings.
mkStrQ :: [StrQ] -> NExpr
mkStrQ = ([Antiquoted Text NExpr] -> NString NExpr) -> [StrQ] -> NExpr
mkStrQtmpl [Antiquoted Text NExpr] -> NString NExpr
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted
-- | Create a single-quoted string from a list of antiquotes/plain strings.
mkStrQI :: [StrQ] -> NExpr
mkStrQI = ([Antiquoted Text NExpr] -> NString NExpr) -> [StrQ] -> NExpr
mkStrQtmpl (Int -> [Antiquoted Text NExpr] -> NString NExpr
forall r. Int -> [Antiquoted Text r] -> NString r
Indented Int
2)