extremely basic Rlp2Core

src/Rlp/AltSyntax.hs

@@ -9,6 +9,7 @@ module Rlp.AltSyntax
     , pattern IntT, pattern TypeT
     , Core.Rec(..)
 
+    , TypedRlpExpr'
     , AnnotatedRlpExpr, TypedRlpExpr
     , TypeF(..)
 
@@ -27,6 +28,7 @@ module Rlp.AltSyntax
 
     -- * Misc
     , serialiseCofree
+    , fixCofree
     )
     where
 --------------------------------------------------------------------------------
@@ -40,7 +42,7 @@ import GHC.Generics             ( Generic, Generic1
 import Data.Hashable
 import Data.Hashable.Lifted
 import GHC.Exts                 (IsString)
-import Control.Lens             hiding ((.=))
+import Control.Lens             hiding ((.=), (:<))
 
 import Data.Functor.Extend
 import Data.Functor.Foldable.TH
@@ -58,6 +60,7 @@ import Core.Syntax              qualified as Core
 type RlpExpr' = RlpExpr PsName
 type RlpExprF' = RlpExprF PsName
 type AnnotatedRlpExpr' = Cofree (RlpExprF PsName)
+type TypedRlpExpr' = TypedRlpExpr PsName
 type Type' = Type PsName
 
 type AnnotatedRlpExpr b = Cofree (RlpExprF b)
@@ -313,3 +316,11 @@ serialiseCofree = cata \case
     ann :<$ e -> object [ "ann" .= ann
                         , "val" .= toJSON1 e ]
 
+--------------------------------------------------------------------------------
+
+fixCofree :: (Functor f, Functor g)
+          => Iso (Fix f) (Fix g) (Cofree f ()) (Cofree g b)
+fixCofree = iso sa bt where
+    sa = foldFix (() :<)
+    bt (_ :< f) = Fix (bt <$> f)
+