Add synonyms (:|), (<|) for NonEmpty. Reimplement show with synonym.

Author: yangzai

sdk/compiler/damlc/daml-preprocessor/src/DA/Daml/Preprocessor.hs

@@ -89,6 +89,7 @@ preprocessorExceptions = Set.fromList $ map GHC.mkModuleName
 
     -- This module needs to use the PatternSynonyms extension.
     , "DA.Maybe"
+    , "DA.NonEmpty"
     ]
 
 -- Following daml-script modules import Internal for creating psuedo exceptions

sdk/compiler/damlc/daml-stdlib-src/DA/NonEmpty.daml

@@ -1,6 +1,7 @@
 -- Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
 
+{-# LANGUAGE PatternSynonyms #-}
 
 -- | Type and functions for non-empty lists. This module re-exports many functions with
 -- the same name as prelude list functions, so it is expected to import the module qualified.
@@ -13,6 +14,8 @@
 -- ```
 module DA.NonEmpty
   ( NonEmpty(..)
+  , pattern (:|)
+  , (<|)
   , cons
   , append
   , map
@@ -40,10 +43,20 @@ import DA.NonEmpty.Types
 import DA.Traversable qualified as T
 import DA.List qualified as L
 import DA.Action qualified as M
+import DA.Internal.Record qualified
+
+infixr 5 :|
+infixr 5 <|
+
+-- | Pattern synonym for constructing and matching non-empty lists.
+pattern (:|) : a -> [a] -> NonEmpty a
+pattern (:|) x xs = NonEmpty x xs
+{-# COMPLETE (:|) : NonEmpty #-}
 
 deriving instance Eq a => Eq (NonEmpty a)
-deriving instance Show a => Show (NonEmpty a)
 deriving instance Ord a => Ord (NonEmpty a)
+instance Show a => Show (NonEmpty a) where
+  show (x :| xs) = show x <> " :| " <> show xs
 
 -- NonEmpty is defined in a stable LF package so we need to handwrite the {Get,Set}Field instances here.
 
@@ -76,22 +89,26 @@ instance Action NonEmpty where
       ys' = xs >>= toList . f
 
 instance F.Foldable NonEmpty where
-  foldr f z ne = f ne.hd (P.foldr f z ne.tl)
+  foldr f z (h :| t) = f h (P.foldr f z t)
 
 instance T.Traversable NonEmpty where
-  mapA f l = liftA2 NonEmpty (f l.hd) (T.mapA f l.tl)
+  mapA f (h :| t) = liftA2 (:|) (f h) (T.mapA f t)
 
 -- | Prepend an element to a non-empty list.
 cons : a -> NonEmpty a -> NonEmpty a
-cons a ne = NonEmpty a (ne.hd :: ne.tl)
+cons a (h :| t) =  a :| h :: t
+
+-- | Alias for `cons`.
+(<|) : a -> NonEmpty a -> NonEmpty a
+(<|) = cons
 
 -- | Append or concatenate two non-empty lists.
 append : NonEmpty a -> NonEmpty a -> NonEmpty a
-append l r =  NonEmpty l.hd (l.tl ++ toList r)
+append (h :| t) r =  h :| t ++ toList r
 
 -- | Apply a function over each element in the non-empty list.
 map : (a -> b) -> NonEmpty a -> NonEmpty b
-map f ne = NonEmpty (f ne.hd) (P.map f ne.tl)
+map f (h :| t) = f h :| P.map f t
 
 -- | Turn a list into a non-empty list, if possible. Returns
 -- `None` if the input list is empty, and `Some` otherwise.
@@ -130,7 +147,7 @@ delete = deleteBy (==)
 -- | Apply a function repeatedly to pairs of elements from a non-empty list,
 -- from the left. For example, `foldl1 (+) (NonEmpty 1 [2,3,4]) = ((1 + 2) + 3) + 4`.
 foldl1 : (a -> a -> a) -> NonEmpty a -> a
-foldl1 f l = L.foldl f l.hd l.tl
+foldl1 f (h :| t) = L.foldl f h t
 
 -- | Apply a function repeatedly to pairs of elements from a non-empty list,
 -- from the right. For example, `foldr1 (+) (NonEmpty 1 [2,3,4]) = 1 + (2 + (3 + 4))`.
@@ -149,7 +166,7 @@ foldrA f x xs = foldr (\ y acc -> do v <- acc; f y v) (pure x) xs
 
 -- | The same as `foldr1` but running an action each time.
 foldr1A : Action m => (a -> a -> m a) -> NonEmpty a -> m a
-foldr1A f l = M.foldrA f l.hd l.tl
+foldr1A f (h :| t) = M.foldrA f h t
 
 -- | Apply a function repeatedly to pairs of elements from a non-empty list,
 -- from the left, with a given initial value. For example,
@@ -163,7 +180,7 @@ foldlA f x xs = foldl (\ acc y -> do v <- acc; f v y) (pure x) xs
 
 -- | The same as `foldl1` but running an action each time.
 foldl1A : Action m => (a -> a -> m a) -> NonEmpty a -> m a
-foldl1A f l = M.foldlA f l.hd l.tl
+foldl1A f (h :| t) = M.foldlA f h t
 
 instance IsParties (NonEmpty Party) where
   toParties = toList

sdk/compiler/damlc/tests/daml-test-files/NonEmpty.daml

@@ -27,6 +27,7 @@ testOrd = script do
 
 testCons = script do
   cons "a" (NonEmpty "b" []) === NonEmpty "a" ["b"]
+  cons 1 (NonEmpty 2 [3, 4]) === 1 <| 2 :| [3, 4]
 
 testFind = script do
   find (== 1) (NonEmpty 0 []) === None
@@ -47,11 +48,14 @@ testDelete = script do
   delete 1 (NonEmpty 0 [2, 1]) === [0, 2]
   delete 1 (NonEmpty 0 [1, 2, 1]) === [0, 2, 1]
 
-
 testDeleteBy = script do
     deleteBy eq 1 (NonEmpty 0 []) === [0]
     deleteBy eq 1 (NonEmpty 1 []) === []
     deleteBy (/=) 1 (NonEmpty 0 [1]) === [1]
   where
     -- Get dlint to stop complaining.
     eq = (==)
+
+testShow = script do
+  show (NonEmpty 1 []) === "1 :| []"
+  show (NonEmpty "a" ["b", "c"]) === "\"a\" :| [\"b\",\"c\"]"