Print structure of a data type by its type-CodePudding

I want to parse a JSON file into a data type and print an error in case of parsing error along with the expected data structure.

Let's take an example data record:

data Foo = {
  bar :: String
}

I want to print the structure of this data into console when it fails to parse, to show the user what structure the JSON should be. Also, I don't want to hardcode the structure into the error log, to make it typesafe (in a meaning: when I add a new field to the data, it should be printed in case of parse error, too. When it would be hardcoded I would forget to modify the string about the structure to be printed).

It can be easily printed to console when I have a value of this data by simply having the deriving Show on the Foo. But how to print the structure without a value?

It is enough if I would be able to print the type definition literally. But if you have a nice type safe solution that could be nicely formatted it is surely welcome :)

CodePudding user response：

I'm sure there are multiple ways to do this, but I've used generics. If you aren't familiar with generics, you should read the documentation of GHC.Generics.

First, some language extensions and imports:

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}

import GHC.Generics
import GHC.TypeLits ( KnownSymbol, symbolVal )
import Data.Proxy ( Proxy(..) )
import Data.Typeable (typeRep, Typeable)

Using the DefaultSignatures extension along with DeriveGeneric, we can create a typeclass PrintStructure that automatically implements the printStructure function for you. All you need to do is pass in a Proxy with a phantom variable of type WhateverYouWantToPrint.

class PrintStructure a where
    printStructure :: Proxy a -> String
    default printStructure :: (Generic a, PrintStructure' (Rep a)) => Proxy a -> String
    printStructure _ = printStructure' (Proxy :: Proxy (Rep a p))

PrintStucture' is a class that prints the structure of types using their Generic representation.

class PrintStructure' a where
    printStructure' :: Proxy (a p) -> String

Now, the next part isn't going to make sense unless you have read the documentation, so please do that first. (Generics aren't as complicated as they appear).
Implementing PrintStructure' for void and unit types:

-- Empty string, there's nothing to print for them
instance PrintStructure' V1 where
    printStructure' _ = ""

instance PrintStructure' U1 where
    printStructure' _ = ""

Constructors:

instance ( PrintStructure' f
         , KnownSymbol name
         ) => PrintStructure' (C1 ('MetaCons name fx sl) f) where
    printStructure' _ = symbolVal (Proxy @name)
                        " { " 
                        printStructure' (Proxy :: Proxy (f p)) 
                        " }"

Record selectors:

instance ( KnownSymbol name
         , PrintStructure' f
         ) => PrintStructure' (S1 ('MetaSel ('Just name) su ss ds) f) where
    printStructure' _ = symbolVal (Proxy @name)    " :: "    printStructure' (Proxy :: Proxy (f p))

Sums, products, constructor fields and data types:

instance ( PrintStructure' f
         , PrintStructure' g
         ) => PrintStructure' (f :*: g) where
    printStructure' _ = printStructure' (Proxy :: Proxy (f p))
                        ", "
                        printStructure' (Proxy :: Proxy (g p))

instance ( PrintStructure' f
         , PrintStructure' g
         ) => PrintStructure' (f : : g) where
    printStructure' _ = printStructure' (Proxy :: Proxy (f p))
                        " | "
                        printStructure' (Proxy :: Proxy (g p))

instance ( PrintStructure' f
         ) => PrintStructure' (S1 ('MetaSel 'Nothing su ss ds) f) where
    printStructure' _ = printStructure' (Proxy :: Proxy (f p))

instance (Typeable t) => PrintStructure' (Rec0 t) where
    printStructure' _ = show (typeRep (Proxy @t))

instance ( KnownSymbol name
         , PrintStructure' f
         ) => PrintStructure' (D1 ('MetaData name mod pkg nt) f) where
    printStructure' _ = "data "
                        symbolVal (Proxy @name)
                        " = "
                        printStructure' (Proxy :: Proxy (f p))

Now we can test it out.

λ> data Foo = Bar { p :: String, q :: Int } | Baz { r :: Bool } | Qux () Int deriving (Show, Generic)

λ> instance PrintStructure Foo

λ> putStrLn $ printStructure (Proxy :: Proxy Foo)
data Foo = Bar { p :: [Char], q :: Int } | Baz { r :: Bool } | Qux { (), Int }

And it works! As you can see, the formatting isn't the best, but pretty printing shouldn't be much of a problem.