Last active
February 18, 2016 14:50
-
-
Save kuk0/92fff1c91c526ffb0a9e to your computer and use it in GitHub Desktop.
Generic instances for various common data types
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# 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"]) ]) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment