convert ADTs to trees of maps

generics-example.hs

{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MonoLocalBinds        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE UndecidableInstances  #-}

module Foo where

import qualified Data.HashMap.Strict as HM
import           Data.Text           (Text)
import qualified Data.Text           as T
import           Data.Typeable

import           Generics.Eot

data City = City
    { cityName :: Text
    , country  :: Text
    }
    deriving (Generic, Show)

data Person = Person
    { name :: Text
    , age  :: Int
    , city :: City
    }
    deriving (Generic, Show)

c = City "Braunschweig" "Germany"
p = Person "Jonge" 123 c

data NestedMap k v = NestedMap { unnest :: HM.HashMap k (Either v (NestedMap k v)) } deriving (Eq, Show)

class A eot where
  a :: [String] -> eot -> NestedMap String String


instance (A a) => A (Either a Void) where
  a s (Left x) = a s x

instance (B tx, A txs) => A (tx, txs) where
  a (s:ss) (x, xs) = NestedMap $ (HM.fromList [(s, b x)]) `HM.union` unnest (a ss xs)

instance A () where
  a [] () = NestedMap HM.empty

class B eot where
  b :: eot -> Either String (NestedMap String String)

  default b :: (HasEot eot, A (Eot eot)) => eot -> Either String (NestedMap String String)
  b val = Right $ a fields (toEot val)
    where [Constructor _ (Selectors fields)] = constructors $ datatype (Proxy :: Proxy eot)

instance B Int where
  b val = Left $ "Int " ++ show val

instance B Text where
  b val = Left $ "Text " ++ T.unpack val

instance B String where
  b val = Left $ "String " ++ val

instance B City where
instance B Person where