temp.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}


--module DThash where
import Data.Data
import Data.Word
import qualified Codec.Binary.UTF8.String as CodStr
import Data.Time.Clock
--import Crypto.Hash.SHA256
import Data.Digest.SHA256
--import Data.Digest.SHA384
import System.Environment
import GHC.Generics

--type BStr = [Word8]
--type HashF = [Word8] -> [Word8]
type BStr = String
type HashF = String -> String


--toWord8 :: String -> [Word8]
--toWord8 = CodStr.encode
toWord8 :: String -> String
toWord8 x = x

class GHashable f where 
    gcomputeHash :: HashF -> f a -> BStr
    genericConstrName :: f x -> String

instance GHashable U1 where
    gcomputeHash hashf U1 = hashf (toWord8 "U1")
    genericConstrName U1 = ""

instance (GHashable a, GHashable b) => GHashable (a :*: b) where
    gcomputeHash hashf (a :*: b) = 
        concat [gcomputeHash hashf a, 
                gcomputeHash hashf b, 
                toWord8 "Pdt1"]
    genericConstrName (a :*: b) = ""

instance (GHashable a, GHashable b) => GHashable (a :+: b) where
    gcomputeHash hashf (L1 x) = 
        concat [gcomputeHash hashf x, 
                toWord8 "Sum1L1"]
    gcomputeHash hashf (R1 x) = 
        concat [gcomputeHash hashf x, 
                toWord8 "Sum1R1"]
    genericConstrName (L1 l) = genericConstrName l
    genericConstrName (R1 r) = genericConstrName r

instance (GHashable a) => GHashable (D1 c a) where
    gcomputeHash hashf (M1 x) = concat[gcomputeHash hashf x, toWord8 "M1D"]
    genericConstrName (M1 x) = genericConstrName x

instance (GHashable a, Constructor c) => GHashable (C1 c a) where
    gcomputeHash hashf (M1 x) = concat[gcomputeHash hashf x, hashf $ toWord8 $ genericConstrName (M1 x), toWord8 "M1D"]
    genericConstrName x = conName x

instance (GHashable a) => GHashable (S1 c a) where
    gcomputeHash hashf (M1 x) = concat[gcomputeHash hashf x, toWord8 "M1S"]
    genericConstrName x = ""

instance (Show a) => GHashable (K1 i a) where
    gcomputeHash hashf (K1 x) =  concat [hashf (toWord8 $ show x), toWord8 "K1"]
    genericConstrName _ = ""

class Hashable a where
    computeHash :: HashF -> a -> BStr
    default computeHash :: (Generic a, GHashable (Rep a)) => HashF -> a -> BStr
    computeHash hashf x = gcomputeHash hashf (from x) 

data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Generic, Show)

instance (Hashable a, Show a) => Hashable (Tree a) 
instance Hashable Int 

main = print $ show $ computeHash Prelude.id (Node 5 EmptyTree EmptyTree :: Tree Int)

test.hs:63:80:
    Could not deduce (GHashable (M1 i0 c0 a))
      arising from a use of `genericConstrName'
    from the context (GHashable a, Constructor c)
      bound by the instance declaration at test.hs:62:10-59
    The type variables `i0', `c0' are ambiguous
    Possible fix: add a type signature that fixes these type variable(s)
    Note: there are several potential instances:
      instance GHashable a => GHashable (S1 c a)
        -- Defined at test.hs:66:10
      instance (GHashable a, Constructor c) => GHashable (C1 c a)
        -- Defined at test.hs:62:10
      instance GHashable a => GHashable (D1 c a)
        -- Defined at test.hs:58:10
    Possible fix:
      add an instance declaration for (GHashable (M1 i0 c0 a))
    In the second argument of `($)', namely `genericConstrName (M1 x)'
    In the second argument of `($)', namely
      `toWord8 $ genericConstrName (M1 x)'
    In the expression: hashf $ toWord8 $ genericConstrName (M1 x)