@@ -0,0 +1,206 @@
1+-- @inline export makeLayer arity=1
2+-- @inline export runLayer arity=2
3+module Yoga.Om.Layer
4+ ( OmLayer(..)
5+ , makeLayer
6+ , runLayer
7+ , combineRequirements
8+ , provide
9+ , (>->)
10+ , class CheckAllProvided
11+ , class CheckAllLabelsExist
12+ , class CheckLabelExists
13+ ) where
14+
15+import Prelude
16+
17+import Data.Newtype (class Newtype)
18+import Effect.Aff.Class (liftAff)
19+import Prim.Row (class Nub, class Union)
20+import Prim.RowList (class RowToList, Cons, Nil, RowList)
21+import Prim.TypeError (class Fail, Above, Quote, Text)
22+import Record as Record
23+import Record.Studio (class Keys)
24+import Type.Equality (class TypeEquals)
25+import Unsafe.Coerce (unsafeCoerce)
26+import Yoga.Om (Om)
27+import Yoga.Om as Om
28+
29+-- | A layer that requires dependencies (req) and provides services (prov)
30+newtype OmLayer req prov err = OmLayer (Om (Record req) err (Record prov))
31+
32+derive instance Newtype (OmLayer req prov err) _
33+
34+-- | Helper to create a layer from an Om computation
35+makeLayer :: forall req prov err. Om (Record req) err (Record prov) -> OmLayer req prov err
36+makeLayer = OmLayer
37+
38+-- =============================================================================
39+-- Custom Type Errors for Missing Dependencies
40+-- =============================================================================
41+
42+-- | Check if all required dependencies are provided
43+-- If not, show a helpful diff of required vs available
44+class CheckAllProvided (required :: Row Type) (available :: Row Type)
45+
46+instance checkAllProvidedImpl ::
47+ ( RowToList required reqList
48+ , RowToList available availList
49+ , CheckAllLabelsExist reqList availList required available
50+ ) =>
51+ CheckAllProvided required available
52+
53+-- | Check that all labels in required RowList exist in available RowList
54+-- Pass along the original rows for better error messages
55+class CheckAllLabelsExist (required :: RowList Type) (available :: RowList Type) (requiredRow :: Row Type) (availableRow :: Row Type)
56+
57+-- Base case: no more requirements to check
58+instance checkAllLabelsNil :: CheckAllLabelsExist Nil available requiredRow availableRow
59+
60+-- Recursive case: check if this label exists, then check the rest
61+instance checkAllLabelsCons ::
62+ ( CheckLabelExists label ty available requiredRow availableRow
63+ , CheckAllLabelsExist tail available requiredRow availableRow
64+ ) =>
65+ CheckAllLabelsExist (Cons label ty tail) available requiredRow availableRow
66+
67+-- | Check if a single label exists in the available RowList
68+-- This is where the magic happens - we dispatch on RowList structure in the instance head!
69+class CheckLabelExists (label :: Symbol) (ty :: Type) (available :: RowList Type) (requiredRow :: Row Type) (availableRow :: Row Type)
70+
71+-- Found it! The label matches in the instance head
72+-- TypeEquals ensures the types at this label actually match!
73+instance checkLabelExistsFound ::
74+ TypeEquals ty ty' =>
75+ CheckLabelExists label ty (Cons label ty' tail) requiredRow availableRow
76+
77+-- Keep looking: different label, recurse on tail
78+else instance checkLabelExistsKeepLooking ::
79+ CheckLabelExists label ty tail requiredRow availableRow =>
80+ CheckLabelExists label ty (Cons otherLabel otherTy tail) requiredRow availableRow
81+
82+-- Not found: reached end of list, emit custom error WITH FULL CONTEXT!
83+else instance checkLabelExistsNotFound ::
84+ Fail
85+ ( Above
86+ (Text "Missing required dependency!")
87+ (Above
88+ (Text "")
89+ (Above
90+ (Text "The first missing field is: ")
91+ (Above
92+ (Quote label)
93+ (Above
94+ (Text "")
95+ (Above
96+ (Text "The layer requires: ")
97+ (Above
98+ (Quote requiredRow)
99+ (Above
100+ (Text "")
101+ (Above
102+ (Text "But you provided: ")
103+ (Quote availableRow)
104+ )
105+ )
106+ )
107+ )
108+ )
109+ )
110+ )
111+ )
112+ ) =>
113+ CheckLabelExists label ty Nil requiredRow availableRow
114+
115+-- | Run a layer with a given context, with custom error if requirements aren't met
116+runLayer
117+ :: forall req prov err available
118+ . CheckAllProvided req available -- ← Custom error if dependencies missing!
119+ => Record available
120+ -> OmLayer req prov err
121+ -> Om (Record available) err (Record prov)
122+runLayer _ctx layer = unsafeCastLayer layer
123+ where
124+ -- After CheckAllProvided succeeds, we know req ⊆ available at compile time
125+ -- So this cast is safe - we're just telling the type system what it already proved
126+ unsafeCastLayer :: OmLayer req prov err -> Om (Record available) err (Record prov)
127+ unsafeCastLayer = unsafeCoerce
128+
129+-- | The key function: combine two layers with automatic deduplication
130+-- Given two layers with potentially overlapping requirements,
131+-- produce a layer with deduplicated requirements
132+--
133+-- Uses expand to properly widen contexts and errors, then runs both layers!
134+combineRequirements
135+ :: forall req1 req2 prov1 prov2 err1 err2 provMerged provMergedRaw reqMerged reqDeduped _req1 _req2 _err1 _err2
136+ . Union req1 req2 reqMerged
137+ => Nub reqMerged reqDeduped -- ← Automatic deduplication of requirements!
138+ => Union req1 _req1 reqDeduped -- req1 is subset of reqDeduped
139+ => Union req2 _req2 reqDeduped -- req2 is subset of reqDeduped
140+ => Union err1 _err1 () -- Widen errors to empty
141+ => Union err2 _err2 ()
142+ => Union prov1 prov2 provMergedRaw -- Merge provisions
143+ => Nub provMergedRaw provMerged -- Deduplicate provisions too!
144+ => Keys req1 -- Needed for expand
145+ => Keys req2 -- Needed for expand
146+ => OmLayer req1 prov1 err1
147+ -> OmLayer req2 prov2 err2
148+ -> OmLayer reqDeduped provMerged ()
149+combineRequirements (OmLayer build1) (OmLayer build2) = makeLayer do
150+ -- Widen both contexts and errors to allow them to run in the deduplicated context
151+ -- expand allows an Om computation to run in a larger context with larger error row
152+ rec1 <- Om.expand build1 -- Om req1 err1 -> Om reqDeduped ()
153+ rec2 <- Om.expand build2 -- Om req2 err2 -> Om reqDeduped ()
154+ -- Merge the results (Record.merge handles the Nub)
155+ pure (Record.merge rec1 rec2)
156+
157+-- Example proof that this works:
158+-- If we have:
159+-- layer1 :: OmLayer (config :: Config) (logger :: Logger) ()
160+-- layer2 :: OmLayer (config :: Config) (database :: Database) ()
161+--
162+-- Then: combineRequirements layer1 layer2
163+-- Has type: OmLayer (config :: Config) prov3 err3
164+--
165+-- NOT: OmLayer (config :: Config, config :: Config) prov3 err3
166+--
167+-- The duplicated requirement (config, config) is automatically
168+-- deduplicated to just (config) by the Nub constraint!
169+
170+-- =============================================================================
171+-- Vertical Composition (ZLayer-style provide)
172+-- =============================================================================
173+
174+-- | Vertical composition: feed output of one layer into input of another
175+-- | This is the >>> operator from ZIO ZLayer
176+-- |
177+-- | Example:
178+-- | postgresLive :: OmLayer (config :: Config) (postgres :: SQL) ()
179+-- | userRepoLive :: OmLayer (postgres :: SQL) (userRepo :: UserRepo) ()
180+-- |
181+-- | composed = userRepoLive `provide` postgresLive
182+-- | -- Result: OmLayer (config :: Config) (userRepo :: UserRepo) ()
183+provide
184+ :: forall req prov1 prov2 err1 err2 _req _prov1 _err1 _err2
185+ . Union req _req req -- expand constraints
186+ => Union prov1 _prov1 prov1
187+ => Union err1 _err1 ()
188+ => Union err2 _err2 ()
189+ => Keys req
190+ => Keys prov1
191+ => OmLayer prov1 prov2 err2 -- layer that needs prov1, provides prov2
192+ -> OmLayer req prov1 err1 -- layer that needs req, provides prov1
193+ -> OmLayer req prov2 () -- composed: needs req, provides prov2
194+provide (OmLayer layer2) (OmLayer layer1) = makeLayer do
195+ -- Run first layer to get prov1
196+ prov1 <- Om.expand layer1
197+
198+ -- Run second layer with prov1 as context
199+ liftAff $ Om.runOm prov1
200+ { exception: \_ -> pure (unsafeCoerce {}) }
201+ (Om.expand layer2)
202+
203+infixl 9 provide as >->
204+
205+-- TODO: More sophisticated composition operators
206+-- For now, use >>> for simple chains and combineRequirements for parallel deps