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.