Generic instances for various common data types

GenericInstances.hs

{-# LANGUAGE TypeFamilies, DeriveGeneric, TypeOperators, RankNTypes, OverloadedStrings, StandaloneDeriving #-}
module GenericInstances where

-- Generic instances for various common data types
--
-- > runhaskell GenericInstances.hs
-- Test {i = 3, t = "a", v = Vector.fromList [1,2,3], s = HashSet.fromList ["foo","baz","bar"], h = HashMap.fromList [("a",3),("b",4),("c",-1)], os = Set.fromList ["nay","yay"], om = Map.fromList [("f",False),("t",True)], is = IntSet [1,2,3], im = IntMap.fromList [(-3,[]),(0,[("a",True),("b",False)]),(5,[("aaaa",True)])], j = Object (HashMap.fromList [("num",Number 1.000),("array",Array (Vector.fromList [Number 7.000,Null,String "meh"])),("str",String "foo"),("bool",Bool True)])}

import GHC.Generics hiding (Prefix, prec)

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T

import Data.Vector (Vector)
import qualified Data.Vector as V

import Data.Hashable
import Data.HashSet (HashSet)
import qualified Data.HashSet as S
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H

import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap

import Data.Scientific
import Data.Aeson
import TextShow
import TextShow.Generic

-- Text

type Rep0Text = D1 D1Text (C1 C1Text (S1 NoSelector (Rec0 Text)))

instance Generic Text where
    type Rep Text = Rep0Text
    from t = M1 (M1 (M1 (K1 t)))
    to (M1 (M1 (M1 (K1 t)))) = t

data D1Text
data C1Text

instance Datatype D1Text where
    datatypeName _ = "Text"
    moduleName   _ = "Data.Text"

instance Constructor C1Text where
    conName     _ = "Text"
    conIsRecord _ = False

-- Vector

type Rep1Vector = D1 D1Vector (C1 C1Vector (S1 NoSelector (Rec1 [])))

instance Generic1 Vector where
    type Rep1 Vector = D1 D1Vector (C1 C1Vector (S1 NoSelector (Rec1 []))) -- Rep1Vector
    from1 v = M1 (M1 (M1 (Rec1 $ V.toList v)))
    to1 (M1 (M1 (M1 (Rec1 l)))) = V.fromList l

data D1Vector
data C1Vector

instance Datatype D1Vector where
    datatypeName _ = "Vector"
    moduleName   _ = "Data.Vector"

instance Constructor C1Vector  where
    conName _ = "Vector.fromList"

type Rep0Vector a = D1 D1Vector (C1 C1Vector (S1 NoSelector (Rec0 [a])))

instance Generic (Vector a) where
    type Rep (Vector a) = Rep0Vector a
    from v = M1 (M1 (M1 (K1 $ V.toList v)))
    to (M1 (M1 (M1 (K1 l)))) = V.fromList l

-- HashSet

data D1HashSet
data C1HashSet

instance Datatype D1HashSet where
    datatypeName _ = "HashSet"
    moduleName   _ = "Data.HashSet"

instance Constructor C1HashSet  where
    conName _ = "HashSet.fromList"

type Rep0HashSet a = D1 D1HashSet (C1 C1HashSet (S1 NoSelector (Rec0 [a])))

instance (Eq a, Hashable a) => Generic (HashSet a) where
    type Rep (HashSet a) = Rep0HashSet a
    from s = M1 (M1 (M1 (K1 $ S.toList s)))
    to (M1 (M1 (M1 (K1 l)))) = S.fromList l

-- HashMap

type LP k = [] :.: Rec1 ((,) k)   -- list of pairs; LP k v ~ [(k, v)] so LP k ~ [(k, *)]
type Rep1HashMap k = D1 D1HashMap (C1 C1HashMap (S1 NoSelector (LP k)))

instance (Eq k, Hashable k) => Generic1 (HashMap k) where
    type Rep1 (HashMap k) = Rep1HashMap k
    from1 h = M1 (M1 (M1 (Comp1 (Rec1 <$> H.toList h))))
    to1 (M1 (M1 (M1 l))) = H.fromList (unRec1 <$> unComp1 l)

data D1HashMap
data C1HashMap

instance Datatype D1HashMap where
    datatypeName _ = "HashMap"
    moduleName   _ = "Data.HashMap.Strict"

instance Constructor C1HashMap  where
    conName _ = "HashMap.fromList"

type Rep0HashMap k v = D1 D1HashMap (C1 C1HashMap (S1 NoSelector (Rec0 [(k, v)])))

instance (Eq k, Hashable k) => Generic (HashMap k v) where
    type Rep (HashMap k v) = Rep0HashMap k v
    from h = M1 (M1 (M1 (K1 $ H.toList h)))
    to (M1 (M1 (M1 (K1 l)))) = H.fromList l

-- Set

data D1Set
data C1Set

instance Datatype D1Set where
    datatypeName _ = "Set"
    moduleName   _ = "Data.Set"

instance Constructor C1Set  where
    conName _ = "Set.fromList"

type Rep0Set a = D1 D1Set (C1 C1Set (S1 NoSelector (Rec0 [a])))

instance (Eq a, Ord a) => Generic (Set a) where
    type Rep (Set a) = Rep0Set a
    from v = M1 (M1 (M1 (K1 $ Set.toList v)))
    to (M1 (M1 (M1 (K1 l)))) = Set.fromList l

--- Map

--type LP k = [] :.: Rec1 ((,) k)   -- list of pairs; LP k v ~ [(k, v)] so LP k ~ [(k, *)]
type Rep1Map k = D1 D1Map (C1 C1Map (S1 NoSelector (LP k)))

instance (Eq k, Ord k) => Generic1 (Map k) where
    type Rep1 (Map k) = Rep1Map k
    from1 h = M1 (M1 (M1 (Comp1 (Rec1 <$> Map.toList h))))
    to1 (M1 (M1 (M1 l))) = Map.fromList (unRec1 <$> unComp1 l)

data D1Map
data C1Map

instance Datatype D1Map where
    datatypeName _ = "Map"
    moduleName   _ = "Data.Map"

instance Constructor C1Map  where
    conName _ = "Map.fromList"

type Rep0Map k v = D1 D1Map (C1 C1Map (S1 NoSelector (Rec0 [(k, v)])))

instance (Eq k, Ord k) => Generic (Map k v) where
    type Rep (Map k v) = Rep0Map k v
    from m = M1 (M1 (M1 (K1 $ Map.toList m)))
    to (M1 (M1 (M1 (K1 l)))) = Map.fromList l

-- IntSet

type Rep0IntSet = D1 D1IntSet (C1 C1IntSet (S1 NoSelector (Rec0 [IntSet.Key])))

instance Generic IntSet where
    type Rep IntSet = Rep0IntSet
    from s = M1 (M1 (M1 (K1 $ IntSet.toList s)))
    to (M1 (M1 (M1 (K1 t)))) = IntSet.fromList t

data D1IntSet
data C1IntSet

instance Datatype D1IntSet where
    datatypeName _ = "IntSet"
    moduleName   _ = "Data.IntSet"

instance Constructor C1IntSet where
    conName     _ = "IntSet"
    conIsRecord _ = False

-- IntMap
--type LP k = [] :.: Rec1 ((,) k)   -- list of pairs; LP k v ~ [(k, v)] so LP k ~ [(k, *)]
type Rep1IntMap = D1 D1IntMap (C1 C1IntMap (S1 NoSelector (LP IntMap.Key)))

instance Generic1 IntMap where
    type Rep1 IntMap = Rep1IntMap
    from1 m = M1 (M1 (M1 (Comp1 (Rec1 <$> IntMap.toList m))))
    to1 (M1 (M1 (M1 l))) = IntMap.fromList (unRec1 <$> unComp1 l)

data D1IntMap
data C1IntMap

instance Datatype D1IntMap where
    datatypeName _ = "IntMap"
    moduleName   _ = "Data.IntMap"

instance Constructor C1IntMap  where
    conName _ = "IntMap.fromList"

type Rep0IntMap a = D1 D1IntMap (C1 C1IntMap (S1 NoSelector (Rec0 [(IntMap.Key, a)])))

instance Generic (IntMap a) where
    type Rep (IntMap a) = Rep0IntMap a
    from m = M1 (M1 (M1 (K1 $ IntMap.toList m)))
    to (M1 (M1 (M1 (K1 l)))) = IntMap.fromList l

-----------------------

-- JSON Value can now be simply derived
deriving instance Generic Value

-- we can now derive TextShow instances for all these
instance TextShow a => TextShow (Vector a) where
  showbPrec = genericShowbPrec

instance (Eq a, Hashable a, TextShow a) => TextShow (HashSet a) where
  showbPrec = genericShowbPrec

instance (Eq k, Hashable k, TextShow k, TextShow v) => TextShow (HashMap k v) where
  showbPrec = genericShowbPrec

instance (Eq a, Ord a, TextShow a) => TextShow (Set a) where
  showbPrec = genericShowbPrec

instance (Eq k, Ord k, TextShow k, TextShow v) => TextShow (Map k v) where
  showbPrec = genericShowbPrec

instance TextShow IntSet where
  showbPrec = genericShowbPrec

instance TextShow v => TextShow (IntMap v) where
  showbPrec = genericShowbPrec

instance TextShow Scientific where
  showb s = fromString (formatScientific Generic (Just 3) s)

instance TextShow Value where
  showbPrec = genericShowbPrec



-- let's test all of these on a new data type

data Test = Test
  { i :: Int
  , t :: Text
  , v :: Vector Int
  , s :: HashSet Text
  , h :: HashMap Text Int
  , os :: Set Text
  , om :: Map String Bool
  , is :: IntSet
  , im :: IntMap [(Text, Bool)]
  , j :: Value
  } deriving Generic

-- and derive TextShow for it:
instance TextShow Test where
  showbPrec = genericShowbPrec

main :: IO ()
main = T.putStrLn . showt $ Test
  { i = 3
  , t = "a"
  , v = V.fromList [1,2,3]
  , s = S.fromList ["foo", "bar", "baz", "foo"]
  , h = H.fromList [("a", 3), ("b", 4), ("c", -1)]
  , os = Set.fromList ["yay", "nay"]
  , om = Map.fromList [("t", True), ("f", False)]
  , is = IntSet.fromList [1,2,3]
  , im = IntMap.fromList [(0, [("a", True), ("b", False)]), (-3, []), (5, [("aaaa", True)])]
  , j = Object (H.fromList ["num" .= Number 1, "bool" .= Bool True, "str" .= String "foo", "array" .= Array (V.fromList [Number 7, Null, String "meh"]) ])
  }