Skip to content

Instantly share code, notes, and snippets.

@cocreature
Created July 12, 2019 14:00
Show Gist options
  • Save cocreature/774a90182ec17ec1aca340b903a2c379 to your computer and use it in GitHub Desktop.
Save cocreature/774a90182ec17ec1aca340b903a2c379 to your computer and use it in GitHub Desktop.
-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
daml 1.2
module Main where
import DA.Generics
import DA.Next.Map
import DA.List
import DA.Text
data Test = Test
{ field1 : Int
, field2 : Text
} deriving (Eq, Generic, Show)
data A
= C1 Int
| C2 Text
deriving (Eq, Generic, Show)
class GMapKey (f : * -> *) where
gKeyToText : f a -> Text
gKeyFromText : Text -> f a
instance MapKey c => GMapKey (K1 i c) where
gKeyToText (K1 x) = keyToText x
gKeyFromText t = K1 (keyFromText t)
instance GMapKey f => GMapKey (M1 i t f) where
gKeyToText (M1 x) = gKeyToText x
gKeyFromText t = M1 (gKeyFromText t)
gKeyToText' : (Generic a rep, GMapKey rep) => a -> Text
gKeyToText' = gKeyToText . from
gKeyFromText' : (Generic a rep, GMapKey rep) => Text -> a
gKeyFromText' = to . gKeyFromText
instance (GMapKey f, GMapKey g) => GMapKey (f :*: g) where
gKeyToText (P1 f g) = "(" <> gKeyToText f <> ")(" <> gKeyToText g <> ")"
gKeyFromText t = case split t of
(a, b) -> P1 (gKeyFromText a) (gKeyFromText b)
split : Text -> (Text, Text)
split (explode -> ("(" :: r)) = go 0 "" r
split t = error $ "Failed to parse " <> t
go : Int -> Text -> [Text] -> (Text, Text)
go i l ("("::r) = go (i + 1) (l <> "(") r
go 0 l (")"::r) = (l, implode $ init (tail r))
go i l (")"::r) = go (i - 1) (l <> ")") r
go i l (c::r) = go i (l <> c) r
go i l [] = error "Unexpected end"
instance (GMapKey f, GMapKey g) => GMapKey (f :+: g) where
gKeyToText (L1 a) = "0" <> gKeyToText a
gKeyToText (R1 b) = "1" <> gKeyToText b
gKeyFromText t = case explode t of
("0" :: t') -> L1 (gKeyFromText $ implode t')
("1" :: t') -> R1 (gKeyFromText $ implode t')
_ -> error $ "Failed to parse, expected 0 or 1: " <> t
instance MapKey Test where
keyToText = gKeyToText'
keyFromText = gKeyFromText'
instance MapKey A where
keyToText = gKeyToText'
keyFromText = gKeyFromText'
test = scenario do
debug (keyToText $ Test 1 "a")
debug (keyFromText $ keyToText $ Test 1 "a" : Test)
debug (keyToText $ C1 2)
debug (keyToText $ C2 "a")
debug (keyFromText $ keyToText $ C1 2 : A)
debug (keyFromText $ keyToText $ C2 "a" : A)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment