{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Nix expression types and auxiliary functions.
-- Since 'Expr' is actually a fixpoint over the 'ExprF' base functor, this
-- module also exposes auxiliary functions that serve as constructors.
module PureNix.Expr where

import Data.List.NonEmpty (NonEmpty (..))
import PureNix.Identifiers
import PureNix.Prelude

-- | The fixpoint over 'ExprF', see haddocks there for more information.
newtype Expr = Expr {unExpr :: ExprF Expr}
  -- Explicitly using the @newtype@ strategy here makes the 'Show' instance
  -- much nicer, since it makes it so you don't get all the @Expr@
  -- constructors.
  deriving newtype (Show)

-- | Base functor for a Nix expression.
-- We don't aim to be able to represent every valid Nix expression, just the
-- ones that are relevant for PureNix.
--
-- 'ExprF' is the base functor for the 'Expr' fixpoint.
-- This allows us to easily annotate and consume it during pretty-printing.
--
-- Note that 'String', unlike 'Key' and 'Var', is a raw representation of the intended string, completely unquoted and unescaped.
-- That means that it might consist of, for example, a single '"'.
-- It is the job of the printer to figure out how to correctly escape those.
data ExprF f
  = Var Var
  | Lam Var f
  | App f f
  | Attrs [Var] [(f, [Key])] [(Key, f)]
  | Cond f f f
  | List [f]
  | Bin Op f f
  | Not f
  | Sel f Key
  | Let (NonEmpty (Var, f)) f
  | Int Integer
  | Double Double
  | String Text
  | Path Text
  deriving stock (Functor, Foldable, Traversable, Show)

data Op = Update | Equals | And
  deriving (Eq, Show)

foldExpr :: (ExprF r -> r) -> Expr -> r
foldExpr f = go where go = f . fmap go . unExpr

var :: Var -> Expr
var = Expr . Var

lam :: Var -> Expr -> Expr
lam arg body = Expr $ Lam arg body

app :: Expr -> Expr -> Expr
app f x = Expr $ App f x

cond :: Expr -> Expr -> Expr -> Expr
cond c true false = Expr $ Cond c true false

attrs ::
  [Var] ->
  [(Expr, [Key])] ->
  [(Key, Expr)] ->
  Expr
attrs inherits inheritFroms binds = Expr $ Attrs inherits inheritFroms binds

sel :: Expr -> Key -> Expr
sel e s = Expr $ Sel e s

let' :: [(Var, Expr)] -> Expr -> Expr
let' [] body = body
let' (h : t) body = Expr $ Let (h :| t) body

int :: Integer -> Expr
int = Expr . Int

double :: Double -> Expr
double = Expr . Double

string :: Text -> Expr
string = Expr . String

list :: [Expr] -> Expr
list = Expr . List

bin :: Op -> Expr -> Expr -> Expr
bin op a b = Expr $ Bin op a b

path :: Text -> Expr
path = Expr . Path

constructorFieldNames :: [Var]
constructorFieldNames = numberedVars "__field"

not' :: Expr -> Expr
not' = Expr . Not

-- | Convenience constructor for builtins.
-- Takes a Key, and gives you @builtins.key@
builtin :: Key -> Expr
builtin = sel (var "builtins")

--   Just
-- becomes
--   (a: { __tag = "Just"; __field0 = a; })
constructor :: Text -> [Var] -> Expr
constructor conName fields =
  foldr
    lam
    ( attrs
        []
        []
        (("__tag", string conName) : zipWith (\arg (UnsafeVar name) -> (UnsafeKey name, var arg)) fields constructorFieldNames)
    )
    fields