@@ -0,0 +1,39 @@
1+{-# LANGUAGE DefaultSignatures #-}
2+{-# LANGUAGE DerivingStrategies #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
4+{-# LANGUAGE TypeApplications #-}
5+{-# LANGUAGE TypeFamilies #-}
6+{-# LANGUAGE StandaloneDeriving #-}
7+{-# LANGUAGE DerivingVia #-}
8+
9+
10+
11+module Roboservant.Types.BuildFrom where
12+
13+import Data.List.NonEmpty (NonEmpty(..))
14+import qualified Data.List.NonEmpty as NEL
15+import Data.Typeable (Typeable)
16+import qualified Data.Dependent.Map as DM
17+import qualified Type.Reflection as R
18+import Data.Kind
19+import Roboservant.Types.Internal
20+
21+class Typeable x => BuildFrom (x :: Type) where
22+ buildFrom :: Stash -> Maybe (StashValue x)
23+
24+-- | this is a little esoteric: basically, we're always going to use this with
25+-- deriving-via, so we need to look up the underlying `x` and then wrap it in Atom.
26+instance Typeable x => BuildFrom (Atom x) where
27+ buildFrom = fmap (fmap Atom) <$> DM.lookup R.typeRep . getStash
28+
29+deriving via (Atom Bool) instance BuildFrom Bool
30+
31+instance (Typeable x, BuildFrom x) => BuildFrom (Maybe x) where
32+ buildFrom dict = Just options
33+ where options :: StashValue (Maybe x)
34+ options = StashValue $
35+ ([],Nothing) :|
36+ (maybe [] (NEL.toList . getStashValue . fmap Just) $ buildFrom @x dict
37+ )
38+-- instance (BuildFrom a) => BuildFrom [a] -- where
39+ --breakdown x = toDyn x :| mconcat (map (NEL.toList . breakdown) x)