diff --git a/examples/record-variant-tests.dx b/examples/record-variant-tests.dx index 84588504f..871fa2941 100644 --- a/examples/record-variant-tests.dx +++ b/examples/record-variant-tests.dx @@ -20,12 +20,12 @@ Syntax for records, variants, and their types. 'Records :p {} -> {,} +> {} :t {} > { &} :p {,} -> {,} +> {} :t {,} > { &} @@ -316,16 +316,16 @@ myStuff :(Fin 5 => {foo:_ | foo:_ | foo:_ | bar:_ | baz:_}) = :p ordinal {a=(7@Fin 10), b=(2@Fin 3)} > 27 :p fromOrdinal {a:Fin 10 & b:Fin 3} 14 -> {a = 4@Fin 10, b = 1@Fin 3} +> {a = (4@Fin 10), b = (1@Fin 3)} recordsAsIndices : {a:Fin 2 & b:Fin 3}=>{a:Fin 2 & b:Fin 3} = for i. i :p recordsAsIndices -> [ {a = 0@Fin 2, b = 0@Fin 3} -> , {a = 1@Fin 2, b = 0@Fin 3} -> , {a = 0@Fin 2, b = 1@Fin 3} -> , {a = 1@Fin 2, b = 1@Fin 3} -> , {a = 0@Fin 2, b = 2@Fin 3} -> , {a = 1@Fin 2, b = 2@Fin 3} ]@{a: Fin 2 & b: Fin 3} +> [ {a = (0@Fin 2), b = (0@Fin 3)} +> , {a = (1@Fin 2), b = (0@Fin 3)} +> , {a = (0@Fin 2), b = (1@Fin 3)} +> , {a = (1@Fin 2), b = (1@Fin 3)} +> , {a = (0@Fin 2), b = (2@Fin 3)} +> , {a = (1@Fin 2), b = (2@Fin 3)} ]@{a: Fin 2 & b: Fin 3} -- TODO: this still causes an error -- :p for i:(Fin 6). recordsAsIndices.((ordinal i) @ _) diff --git a/examples/serialize-tests.dx b/examples/serialize-tests.dx index f5eaa1c98..af32285d8 100644 --- a/examples/serialize-tests.dx +++ b/examples/serialize-tests.dx @@ -19,6 +19,20 @@ :p () > () +'Records and variants + +:p {a=1, b=2} +> {a = 1, b = 2} + +:p {a="1234", b=[1, 2, 3]} +> {a = ['1', '2', '3', '4'], b = [1, 2, 3]} + +:p [{| a=1 |}, {| b=2.0 |}] : (Fin 2) => {a:Int | b:Float} +> [{| a = 1 |}, {| b = 2.0 |}] + +:p {table = [{| a=1 |}, {| b=2.0 |}]} : {table: (Fin 2) => {a:Int | b:Float}} +> {table = [{| a = 1 |}, {| b = 2.0 |}]} + 'Values without a pretty-printer (currently shows warning message): :p Int diff --git a/src/lib/Serialize.hs b/src/lib/Serialize.hs index f609062da..e977de0d6 100644 --- a/src/lib/Serialize.hs +++ b/src/lib/Serialize.hs @@ -14,6 +14,7 @@ import qualified Data.ByteString as BS import System.Directory import System.FilePath import Data.Foldable (toList) +import qualified Data.Map.Strict as M import Data.Store hiding (size) import Data.Text.Prettyprint.Doc hiding (brackets) @@ -57,8 +58,8 @@ prettyVal val = case val of where DataConDef conName _ = dataCons !! con Con con -> case con of PairCon x y -> do - xStr <- asStr <$> prettyVal x - yStr <- asStr <$> prettyVal y + xStr <- pprintVal x + yStr <- pprintVal y return $ pretty (xStr, yStr) SumAsProd ty (TagRepVal trep) payload -> do let t = fromIntegral trep @@ -79,6 +80,18 @@ prettyVal val = case val of variant = Variant (NoExt types) theLabel repeatNum value _ -> error "SumAsProd with an unsupported type" _ -> return $ pretty con + Record (LabeledItems row) -> do + let separator = line' <> "," + let bindwith = " =" + let elems = concatMap (\(k, vs) -> map (k,) (toList vs)) (M.toAscList row) + let fmElem = \(label :: Label, v) -> do + vStr <- prettyVal v + return $ pretty label <> bindwith <+> vStr + docs <- mapM fmElem elems + let innerDoc = "{" <> flatAlt " " "" + <> concatWith (surround (separator <> " ")) docs + <> "}" + return $ align $ group innerDoc atom -> return $ prettyPrec atom LowestPrec -- TODO: this isn't enough, since this module's compilation might be cached