@@ -8,14 +8,26 @@ module Data.Schematic.Lens
88 , FElem(..)
99 , FImage
1010 , FSubset(..)
11+ , obj
12+ , textRepr
13+ , numberRepr
14+ , boolRepr
15+ , arrayRepr
16+ , objectRepr
17+ , optionalRepr
1118 ) where
1219
20+import Data.Profunctor
1321import Data.Proxy
1422import Data.Schematic.Schema
23+import Data.Scientific
24+import Data.Singletons
25+import Data.Text
26+import Data.Vector as V
1527import Data.Vinyl
1628import Data.Vinyl.Functor
1729import Data.Vinyl.TypeLevel (Nat(..))
18−import GHC.TypeLits (Symbol)
30+import GHC.TypeLits (Symbol, KnownSymbol)
1931
2032
2133-- | A partial relation that gives the index of a value in a list.
@@ -70,7 +82,7 @@ instance (FIndex r (s ': rs) ~ 'S i, FElem r rs i) => FElem r (s ': rs) ('S i) w
7082 fput y = getIdentity . flens Proxy (\_ -> Identity y)
7183 {-# INLINE fput #-}
7284
73−-- This is an internal convenience stolen from the @lens@ library.
85+-- This is an internal convenience helpers stolen from the @lens@ library.
7486lens
7587 :: Functor f
7688 => (t -> s)
@@ -81,6 +93,17 @@ lens
8193lens sa sbt afb s = fmap (sbt s) $ afb (sa s)
8294{-# INLINE lens #-}
8395
96+type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
97+
98+type Iso' s a = Iso s s a a
99+
100+iso
101+ :: (s -> a)
102+ -> (b -> t)
103+ -> Iso s t a b
104+iso sa bt = dimap sa (fmap bt)
105+{-# INLINE iso #-}
106+
84107-- | A partial relation that gives the indices of a sublist in a larger list.
85108type family FImage (rs :: [(Symbol, Schema)]) (ss :: [(Symbol, Schema)]) :: [Nat] where
86109 FImage '[] ss = '[]
@@ -125,3 +148,37 @@ instance
125148 where
126149 set :: Rec FieldRepr ss -> Rec FieldRepr ( '(fn,s) ': rs) -> Rec FieldRepr ss
127150 set ss (r :& rs) = fput r $ freplace rs ss
151+
152+-- A bunch of @Iso@morphisms
153+textRepr
154+ :: (KnownSymbol fn, SingI fn, SingI cs)
155+ => Iso' (FieldRepr '(fn, ('SchemaText cs))) Text
156+textRepr = iso (\(FieldRepr (ReprText t)) -> t) (FieldRepr . ReprText)
157+
158+numberRepr
159+ :: (KnownSymbol fn, SingI fn, SingI cs)
160+ => Iso' (FieldRepr '(fn, ('SchemaNumber cs))) Scientific
161+numberRepr = iso (\(FieldRepr (ReprNumber n)) -> n) (FieldRepr . ReprNumber)
162+
163+boolRepr
164+ :: (KnownSymbol fn, SingI fn, SingI cs)
165+ => Iso' (FieldRepr '(fn, 'SchemaBoolean)) Bool
166+boolRepr = iso (\(FieldRepr (ReprBoolean b)) -> b) (FieldRepr . ReprBoolean)
167+
168+arrayRepr
169+ :: (KnownSymbol fn, SingI fn, SingI cs, SingI schema)
170+ => Iso' (FieldRepr '(fn, ('SchemaArray cs schema))) (V.Vector (JsonRepr schema))
171+arrayRepr = iso (\(FieldRepr (ReprArray a)) -> a) (FieldRepr . ReprArray)
172+
173+objectRepr
174+ :: (KnownSymbol fn, SingI fn, SingI fields)
175+ => Iso' (FieldRepr '(fn, ('SchemaObject fields))) (Rec FieldRepr fields)
176+objectRepr = iso (\(FieldRepr (ReprObject o)) -> o) (FieldRepr . ReprObject)
177+
178+optionalRepr
179+ :: (KnownSymbol fn, SingI fn, SingI schema)
180+ => Iso' (FieldRepr '(fn, ('SchemaOptional schema))) (Maybe (JsonRepr schema))
181+optionalRepr = iso (\(FieldRepr (ReprOptional r)) -> r) (FieldRepr . ReprOptional)
182+
183+obj :: (SingI fields) => Iso' (JsonRepr ('SchemaObject fields)) (Rec FieldRepr fields)
184+obj = iso (\(ReprObject r) -> r) ReprObject