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

-- | This module defines the types and conversions from PureScript/CoreFn identifiers to Nix identifiers.
-- This can be a tricky problem, since all three languages have different rules for what is and isn't allowed in certain kinds of identifiers.
-- The goal of this module is to provide an API that takes care of all those concerns.
-- In other words, the types in this module are as close to ready-to-print as possible.
--
-- The reasoning is that 'Key' and 'Var' are intended to be used in 'Expr'.
-- 'Expr' should represent a _valid_ Nix expression, and therefore 'Key' and 'Var' need to represent valid keys and binders, respectively.
-- We don't have to care about rejecting nonsensical values during printing.
--
-- Nix's rules for naked (non-quoted) identifiers are strictly more lenient than PureScripts (see links to specifications below), since nix allows '-' in identifiers (they cannot start with a '-' though).
-- Unfortunately, that doesn't mean we can just naively convert identifiers, for example:
--  - generated identifiers such as dictionary names in CoreFn can contain '$'
--  - module names can contain '.'
--  - keys might be quoted
--  - we shouldn't shadow Nix keywords, especially those that aren't also PureScript keywords
--  - we reserve any identifier starting with two leading underscores
--
-- Purescript identifiers:
-- https://github.com/purescript/purescript/blob/master/lib/purescript-cst/src/Language/PureScript/CST/Lexer.hs#L689
-- Nix identifiers:
-- https://github.com/cstrahan/tree-sitter-nix/blob/master/src/grammar.json#L19
module PureNix.Identifiers
  ( Var (..),
    mkVar,
    numberedVars,
    Key (..),
    identKey,
    stringKey,
    moduleKey,
    binderKey,
    numberedKeys,
  )
where

import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import qualified Language.PureScript as PS
import qualified Language.PureScript.PSString as PS

-- TODO rename to Binder, since this can occur in the LHS of a let-binding

-- | A valid (i.e. containing no illegal characters) variable binder.
-- Primarily constructed using 'mkVar'.
newtype Var = UnsafeVar {Var -> Text
unVar :: Text}
  deriving newtype (String -> Var
forall a. (String -> a) -> IsString a
fromString :: String -> Var
$cfromString :: String -> Var
IsString, Var -> Var -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c== :: Var -> Var -> Bool
Eq, Int -> Var -> ShowS
[Var] -> ShowS
Var -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Var] -> ShowS
$cshowList :: [Var] -> ShowS
show :: Var -> String
$cshow :: Var -> String
showsPrec :: Int -> Var -> ShowS
$cshowsPrec :: Int -> Var -> ShowS
Show)

identToText :: PS.Ident -> Text
identToText :: Ident -> Text
identToText (PS.Ident Text
t) = Text
t
-- GenIdent is only used in PureScript for "unnamed" instances.
-- Originally, in PureScript, all instances needed to be named:
-- https://github.com/purescript/documentation/blob/master/language/Differences-from-Haskell.md#named-instances
-- This was relaxed in 0.14.2:
-- https://github.com/purescript/purescript/pull/4096
identToText (PS.GenIdent Maybe Text
mvar Integer
n) = forall a. a -> Maybe a -> a
fromMaybe Text
"__instance" Maybe Text
mvar forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Integer
n)
identToText Ident
PS.UnusedIdent = Text
"_"
identToText (PS.InternalIdent InternalIdentData
_) = forall a. HasCallStack => String -> a
error String
"impossible"

-- | Make a Nix variable binder from a CoreFn binder.
--
-- If a binder is a Nix keyword, we tick the binder with a hyphen.
-- Since PureScript does not allow binders to contain hyphens, this should be safe.
--
-- Additionally, CoreFn can put dollar signs in generated names.
-- We simply drop leading dollar signs, and the rest we convert to hyphens.
mkVar :: PS.Ident -> Var
mkVar :: Ident -> Var
mkVar = Text -> Var
UnsafeVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
removeDollarSigns forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tickKeywords forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
identToText
  where
    tickKeywords :: Text -> Text
tickKeywords Text
w
      | forall a. Ord a => a -> Set a -> Bool
Set.member Text
w Set Text
keywords Bool -> Bool -> Bool
|| Text -> Text -> Bool
T.isPrefixOf Text
"__" Text
w = Text
w forall a. Semigroup a => a -> a -> a
<> Text
"-"
      | Bool
otherwise = Text
w
    removeDollarSigns :: Text -> Text
removeDollarSigns Text
w =
      (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'$' then Char
'-' else Char
c) forall a b. (a -> b) -> a -> b
$
        if Text -> Text -> Bool
T.isPrefixOf Text
"$" Text
w then Text -> Text
T.tail Text
w else Text
w

keywords :: Set Text
keywords :: Set Text
keywords = forall a. Ord a => [a] -> Set a
Set.fromList ([Text]
purenixIdents forall a. Semigroup a => a -> a -> a
<> [Text]
nixPrimops forall a. Semigroup a => a -> a -> a
<> [Text]
nixKeywords)
  where
    purenixIdents :: [Text]
purenixIdents = [Text
"module", Text
"foreign"]
    -- These are not keywords in the sense that they can be shadowed
    -- For example, let true = false; in true is valid Nix.
    nixPrimops :: [Text]
nixPrimops = [Text
"builtins", Text
"import", Text
"false", Text
"true"]
    -- keywords in nix:
    -- https://github.com/NixOS/nix/blob/90b2dd570cbd8313a8cf45b3cf66ddef2bb06e07/src/libexpr/lexer.l#L115-L124
    nixKeywords :: [Text]
    nixKeywords :: [Text]
nixKeywords =
      [Text
"if", Text
"then", Text
"else", Text
"assert", Text
"with", Text
"let", Text
"in", Text
"rec", Text
"inherit", Text
"or"]

-- | A valid Nix attribute key
newtype Key = UnsafeKey {Key -> Text
unKey :: Text}
  deriving newtype (String -> Key
forall a. (String -> a) -> IsString a
fromString :: String -> Key
$cfromString :: String -> Key
IsString, Key -> Key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show)

moduleKey :: PS.ModuleName -> Key
moduleKey :: ModuleName -> Key
moduleKey (PS.ModuleName Text
mdl) = Text -> Key
UnsafeKey forall a b. (a -> b) -> a -> b
$ Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
mdl forall a. Semigroup a => a -> a -> a
<> Text
"\""

identKey :: PS.Ident -> Key
identKey :: Ident -> Key
identKey = Text -> Key
UnsafeKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Text
unVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Var
mkVar

stringKey :: PS.PSString -> Key
stringKey :: PSString -> Key
stringKey = Text -> Key
UnsafeKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSString -> Text
PS.prettyPrintObjectKey

binderKey :: Var -> Key
binderKey :: Var -> Key
binderKey = Text -> Key
UnsafeKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Text
unVar

numberedText :: Text -> [Text]
numberedText :: Text -> [Text]
numberedText Text
prefix = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
n -> Text
prefix forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
n)) [Int
0 :: Int ..]

numberedVars :: Text -> [Var]
numberedVars :: Text -> [Var]
numberedVars = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Var
UnsafeVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
numberedText

numberedKeys :: Text -> [Key]
numberedKeys :: Text -> [Key]
numberedKeys = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
UnsafeKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
numberedText