@@ -1,59 +1,65 @@
11{-# LANGUAGE AllowAmbiguousTypes #-}
22{-# LANGUAGE DataKinds #-}
33{-# LANGUAGE DerivingVia #-}
4−{-# LANGUAGE DerivingVia #-}
5−
6−{-# LANGUAGE StandaloneDeriving #-}
7−{-# LANGUAGE StandaloneDeriving #-}
8−
9−{-# LANGUAGE FlexibleInstances #-}
104{-# LANGUAGE FlexibleInstances #-}
11−
125{-# LANGUAGE GADTs #-}
13−{-# LANGUAGE GADTs #-}
14−
15−{-# LANGUAGE DefaultSignatures #-}
16−{-# LANGUAGE DerivingStrategies #-}
17−{-# LANGUAGE FlexibleInstances #-}
18−{-# LANGUAGE GADTs #-}
19−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
206{-# LANGUAGE LambdaCase #-}
217{-# LANGUAGE MultiParamTypeClasses #-}
228{-# LANGUAGE PolyKinds #-}
239{-# LANGUAGE ScopedTypeVariables #-}
24−{-# LANGUAGE TypeApplications #-}
10+{-# LANGUAGE StandaloneDeriving #-}
2511{-# LANGUAGE TypeFamilies #-}
12+{-# LANGUAGE TypeOperators #-}
2613{-# LANGUAGE UndecidableInstances #-}
27−{-# LANGUAGE StandaloneDeriving #-}
28−{-# LANGUAGE DerivingVia #-}
29−
3014
3115module Roboservant.Types.Breakdown where
3216
33−import Data.Dynamic (Dynamic, fromDynamic, toDyn)
17+import Data.Dynamic (Dynamic, toDyn)
3418import Data.List.NonEmpty (NonEmpty (..))
35−import qualified Data.List.NonEmpty as NEL
36−import Data.Maybe (fromMaybe)
37−import GHC.Generics(Generic)
19+import GHC.Generics
3820import Data.Typeable (Typeable)
3921import Roboservant.Types.Internal
4022import Data.Hashable
23+import Data.Kind
24+import qualified Data.List.NonEmpty as NEL
4125
42−-- | only use this when we are using the internal typerep map.
43−promisedDyn :: Typeable a => Dynamic -> a
44−promisedDyn = fromMaybe (error "internal error, typerep map misconstructed") . fromDynamic
26+breakdown :: (Hashable x, Typeable x, Breakdown x)
27+ => x -> NonEmpty (Dynamic, Int)
28+breakdown x = hashedDyn x :| breakdownExtras x
4529
4630class Breakdown x where
47− breakdown :: x -> NonEmpty (Dynamic,Int)
48−-- default breakdown :: Typeable x => x -> NonEmpty Dynamic
49−-- breakdown = pure . toDyn
50−
31+ breakdownExtras :: x -> [(Dynamic,Int)]
5132
5233instance (Hashable x, Typeable x) => Breakdown (Atom x) where
53− breakdown (Atom x) = pure (toDyn x, hash x)
34+ breakdownExtras (Atom x) = [(toDyn x, hash x)]
5435
5536deriving via (Atom ()) instance Breakdown ()
5637deriving via (Atom Int) instance Breakdown Int
38+deriving via (Atom [Char]) instance Breakdown [Char]
39+
40+class GBreakdown (f :: k -> *) where
41+ gBreakdownExtras :: f a -> [(Dynamic,Int)]
42+
43+instance (Hashable x, Typeable x, Generic x, GBreakdown (Rep x)) => Breakdown (Compound (x::Type)) where
44+ breakdownExtras = gBreakdownExtras . from . unCompound
45+
46+instance GBreakdown f => GBreakdown (M1 S c f ) where
47+ gBreakdownExtras (M1 f) = gBreakdownExtras f
48+
49+instance GBreakdown b => GBreakdown (M1 D a b) where
50+ gBreakdownExtras (M1 f) = gBreakdownExtras f
51+
52+
53+instance GBreakdown b => GBreakdown (M1 C a b) where
54+ gBreakdownExtras (M1 f) = gBreakdownExtras f
55+
56+instance (GBreakdown a, GBreakdown b) => GBreakdown (a :*: b) where
57+ gBreakdownExtras (a :*: b) = gBreakdownExtras a <> gBreakdownExtras b
58+
59+instance (GBreakdown a, GBreakdown b) => GBreakdown (a :+: b) where
60+ gBreakdownExtras = \case
61+ L1 a -> gBreakdownExtras a
62+ R1 a -> gBreakdownExtras a
5763
58−-- instance (Typeable a, Breakdown a) => Breakdown [a] where
59−-- breakdown x = toDyn x :| mconcat (map (NEL.toList . breakdown) x)
64+instance (Hashable a, Typeable a, Breakdown a) => GBreakdown (K1 R a) where
65+ gBreakdownExtras (K1 c) = NEL.toList $ breakdown c