diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,9 @@
 # Revision history for schematic
 
+## 0.4.0.0 -- 2017-10-17
+
+Object building DSL, more convenience helpers, MCons simplified with Tagged
+
 ## 0.3.2.0 -- 2017-10-02
 
 Fixed FIndex bug, added bunch of convenience isomorphism, re-exports.
diff --git a/schematic.cabal b/schematic.cabal
--- a/schematic.cabal
+++ b/schematic.cabal
@@ -1,5 +1,5 @@
 name:                schematic
-version:             0.3.2.0
+version:             0.4.0.0
 synopsis:            JSON-biased spec and validation tool
 license:             BSD3
 license-file:        LICENSE
@@ -14,6 +14,7 @@
 
 library
   exposed-modules:     Data.Schematic
+                     , Data.Schematic.DSL
                      , Data.Schematic.Instances
                      , Data.Schematic.JsonSchema
                      , Data.Schematic.Helpers
@@ -22,7 +23,6 @@
                      , Data.Schematic.Path
                      , Data.Schematic.Schema
                      , Data.Schematic.Validation
-                     , Data.Schematic.Utils
   ghc-options:       -Wall
   default-extensions:  ConstraintKinds
                      , DataKinds
@@ -70,7 +70,9 @@
                      , singletons >= 2.2
                      , smallcheck
                      , tagged
+                     , template-haskell
                      , text
+                     , union
                      , unordered-containers
                      , validationt >= 0.1.0.1
                      , vector
diff --git a/src/Data/Schematic.hs b/src/Data/Schematic.hs
--- a/src/Data/Schematic.hs
+++ b/src/Data/Schematic.hs
@@ -7,7 +7,6 @@
   , module Data.Schematic.Lens
   , module Data.Schematic.Migration
   , module Data.Schematic.Schema
-  , module Data.Schematic.Utils
   , decodeAndValidateJson
   , parseAndValidateJson
   , parseAndValidateJsonBy
@@ -19,21 +18,24 @@
   , isDecodingError
   , isValidationError
   , ParseResult(..)
+  , withRepr
+  , field
   ) where
 
 import Control.Monad.Validation
 import Data.Aeson as J
 import Data.Aeson.Types as J
 import Data.ByteString.Lazy as BL
-import Data.Functor.Identity
-import Data.Schematic.JsonSchema
+import Data.Functor.Identity as F
+import Data.Schematic.DSL
 import Data.Schematic.Helpers
+import Data.Schematic.JsonSchema
 import Data.Schematic.Lens
 import Data.Schematic.Migration
 import Data.Schematic.Schema
-import Data.Schematic.Utils
 import Data.Schematic.Validation
-import Data.Singletons.Prelude
+import Data.Singletons.Prelude hiding ((:.))
+import Data.Tagged
 import Data.Text as T
 
 
@@ -84,7 +86,8 @@
   -> J.Value
   -> m (ParseResult (JsonRepr (Head revisions)))
 parseAndValidateWithMList MNil v = pure $ parseAndValidateJson v
-parseAndValidateWithMList ((:&&) p f tl) v = case parseAndValidateJsonBy p v of
+parseAndValidateWithMList (Tagged f :&& tl) v =
+  case parseAndValidateJsonBy Proxy v of
     Valid a           -> pure $ Valid a
     DecodingError _   -> do
       pr <- parseAndValidateWithMList tl v
@@ -120,7 +123,7 @@
 
 decodeAndValidateVersionedWithPureMList
   :: proxy versioned
-  -> MList Identity (MapSnd (AllVersions versioned))
+  -> MList F.Identity (MapSnd (AllVersions versioned))
   -> BL.ByteString
   -> ParseResult (JsonRepr (Head (MapSnd (AllVersions versioned))))
 decodeAndValidateVersionedWithPureMList a b c =
diff --git a/src/Data/Schematic/DSL.hs b/src/Data/Schematic/DSL.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Schematic/DSL.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Data.Schematic.DSL where
+
+import           Data.Kind
+import           Data.Schematic.Lens
+import           Data.Schematic.Migration
+import           Data.Schematic.Schema
+import           Data.Scientific
+import           Data.Singletons
+import           Data.Singletons.Prelude hiding ((:.))
+import           Data.Singletons.TypeLits
+import           Data.Tagged
+import           Data.Text as T
+import           Data.Union
+import qualified Data.Vector as V
+import           Data.Vinyl
+import           Data.Vinyl.Functor
+
+
+type Constructor a
+  = forall b. FSubset (FieldsOf a) b (FImage (FieldsOf a) b)
+  => Rec (Tagged (FieldsOf a) :. FieldRepr) b
+  -> JsonRepr ('SchemaObject (FieldsOf a))
+
+withRepr :: Constructor a
+withRepr = ReprObject . rmap (unTagged . getCompose) . fcast
+
+class Representable s where
+  constructField :: Sing fn -> Proxy s -> Repr s -> FieldRepr '(fn, s)
+
+instance SingI so => Representable ('SchemaObject so) where
+  constructField sfn _ o = withKnownSymbol sfn $ FieldRepr $ ReprObject o
+
+instance (SingI cs, SingI sa) => Representable ('SchemaArray cs sa) where
+  constructField sfn _ a = withKnownSymbol sfn $ FieldRepr $ ReprArray a
+
+instance SingI cs => Representable ('SchemaText cs) where
+  constructField sfn _ t = withKnownSymbol sfn $ FieldRepr $ ReprText t
+
+instance SingI cs => Representable ('SchemaNumber cs) where
+  constructField sfn _ n = withKnownSymbol sfn $ FieldRepr $ ReprNumber n
+
+instance Representable 'SchemaBoolean where
+  constructField sfn _ b = withKnownSymbol sfn $ FieldRepr $ ReprBoolean b
+
+instance SingI so => Representable ('SchemaOptional so) where
+  constructField sfn _ o = withKnownSymbol sfn $ FieldRepr $ ReprOptional o
+
+instance SingI (h ': tl) => Representable ('SchemaUnion (h ': tl)) where
+  constructField sfn _ u = withKnownSymbol sfn $ FieldRepr $ ReprUnion u
+
+construct :: Sing s -> Repr s -> JsonRepr s
+construct s r = case s of
+  SSchemaObject _          -> ReprObject r
+  SSchemaArray _ _         -> ReprArray r
+  SSchemaText _            -> ReprText r
+  SSchemaNumber _          -> ReprNumber r
+  SSchemaBoolean           -> ReprBoolean r
+  SSchemaOptional _        -> ReprOptional r
+  SSchemaNull              -> ReprNull
+  SSchemaUnion ss          -> case ss of
+    SNil      -> error "unconstructable union"
+    SCons _ _ -> ReprUnion r
+
+type family FieldsOf (s :: Schema) :: [(Symbol, Schema)] where
+  FieldsOf ('SchemaObject fs) = fs
+
+type FieldConstructor fn =
+  forall fs. (Representable (ByField fn fs (FIndex fn fs)))
+  => Repr (ByField fn fs (FIndex fn fs))
+  -> (Tagged fs :. FieldRepr) '(fn, (ByField fn fs (FIndex fn fs)))
+
+field :: forall fn. KnownSymbol fn => FieldConstructor fn
+field = Compose . Tagged . constructField (sing :: Sing fn) Proxy
+
+type family Repr (s :: Schema) = (ty :: Type) where
+  Repr ('SchemaObject so) = Rec FieldRepr so
+  Repr ('SchemaArray cs sa) = V.Vector (JsonRepr sa)
+  Repr ('SchemaText cs) = Text
+  Repr ('SchemaNumber cs) = Scientific
+  Repr 'SchemaBoolean = Bool
+  Repr ('SchemaOptional so) = Maybe (JsonRepr so)
+  Repr ('SchemaUnion (h ': tl)) = Union JsonRepr (h ': tl)
diff --git a/src/Data/Schematic/JsonSchema.hs b/src/Data/Schematic/JsonSchema.hs
--- a/src/Data/Schematic/JsonSchema.hs
+++ b/src/Data/Schematic/JsonSchema.hs
@@ -16,6 +16,7 @@
 import Data.Schematic.Schema as S
 import Data.Singletons
 import Data.Text
+import Data.Traversable
 import JSONSchema.Draft4.Schema as D4
 import JSONSchema.Validator.Draft4 as D4
 
@@ -62,31 +63,43 @@
   :: forall proxy schema
    . SingI schema
   => proxy (schema :: S.Schema)
-  -> D4.Schema
-toJsonSchema _ = (toJsonSchema' $ fromSing (sing :: Sing schema))
-  { _schemaVersion = pure draft4 }
+  -> Maybe D4.Schema
+toJsonSchema _ = do
+  js <- toJsonSchema' $ fromSing (sing :: Sing schema)
+  pure $ js { _schemaVersion = pure draft4 }
 
 toJsonSchema'
   :: DemotedSchema
-  -> D4.Schema
+  -> Maybe D4.Schema
 toJsonSchema' = \case
   DSchemaText tcs ->
-    execState (traverse_ textConstraint tcs) $ emptySchema
+    pure $ execState (traverse_ textConstraint tcs) $ emptySchema
       { _schemaType = pure $ TypeValidatorString D4.SchemaString }
   DSchemaNumber ncs ->
-    execState (traverse_ numberConstraint ncs) $ emptySchema
+    pure $ execState (traverse_ numberConstraint ncs) $ emptySchema
       { _schemaType = pure $ TypeValidatorString D4.SchemaNumber }
-  DSchemaBoolean -> emptySchema
-      { _schemaType = pure $ TypeValidatorString D4.SchemaBoolean }
-  DSchemaObject objs -> emptySchema
-      { _schemaType = pure $ TypeValidatorString D4.SchemaObject
-      , _schemaProperties = pure $ H.fromList $ (\(n,s) -> (n, toJsonSchema' s))
-        <$> objs }
-  DSchemaArray acs sch ->
-    execState (traverse_ arrayConstraint acs) $ emptySchema
-      { _schemaType = pure $ TypeValidatorString D4.SchemaArray
-      , _schemaItems = pure $ ItemsArray [toJsonSchema' sch] }
-  DSchemaNull -> emptySchema
-      { _schemaType = pure $ TypeValidatorString D4.SchemaNull }
-  DSchemaOptional sch -> emptySchema
-      { _schemaOneOf = pure $ toJsonSchema' DSchemaNull :| [toJsonSchema' sch] }
+  DSchemaBoolean -> pure $ emptySchema
+    { _schemaType = pure $ TypeValidatorString D4.SchemaBoolean }
+  DSchemaObject objs -> do
+    res <- for objs $ \(n,s) -> do
+      s' <- toJsonSchema' s
+      pure (n, s')
+    pure $ emptySchema
+      { _schemaType       = pure $ TypeValidatorString D4.SchemaObject
+      , _schemaProperties = pure $ H.fromList res }
+  DSchemaArray acs sch -> do
+    res <- toJsonSchema' sch
+    pure $ execState (traverse_ arrayConstraint acs) $ emptySchema
+      { _schemaType  = pure $ TypeValidatorString D4.SchemaArray
+      , _schemaItems = pure $ ItemsArray [res] }
+  DSchemaNull -> pure $ emptySchema
+    { _schemaType = pure $ TypeValidatorString D4.SchemaNull }
+  DSchemaOptional sch -> do
+    snull <- toJsonSchema' DSchemaNull
+    sres <- toJsonSchema' sch
+    pure $ emptySchema { _schemaOneOf = pure (snull :| [sres]) }
+  DSchemaUnion sch -> do
+    schemaUnion <- traverse toJsonSchema' sch >>= \case
+      [] -> Nothing
+      x  -> Just x
+    pure $ emptySchema { _schemaAnyOf = pure $ NE.fromList schemaUnion }
diff --git a/src/Data/Schematic/Lens.hs b/src/Data/Schematic/Lens.hs
--- a/src/Data/Schematic/Lens.hs
+++ b/src/Data/Schematic/Lens.hs
@@ -9,6 +9,7 @@
   , FImage
   , FSubset(..)
   , obj
+  , arr
   , textRepr
   , numberRepr
   , boolRepr
@@ -40,23 +41,23 @@
   flens
     :: Functor g
     => proxy fn
-    -> (FieldRepr '(fn, (ByField fn rs i)) -> g (FieldRepr '(fn, (ByField fn rs i))))
-    -> Rec FieldRepr rs
-    -> g (Rec FieldRepr rs)
+    -> (f '(fn, (ByField fn rs i)) -> g (f '(fn, (ByField fn rs i))))
+    -> Rec f rs
+    -> g (Rec f rs)
 
   -- | For Vinyl users who are not using the @lens@ package, we provide a getter.
   fget
     :: proxy fn
-    -> Rec FieldRepr rs
-    -> FieldRepr '(fn, (ByField fn rs i))
+    -> Rec f rs
+    -> f '(fn, (ByField fn rs i))
 
   -- | For Vinyl users who are not using the @lens@ package, we also provide a
   -- setter. In general, it will be unambiguous what field is being written to,
   -- and so we do not take a proxy argument here.
   fput
-    :: FieldRepr '(fn, ByField fn rs i)
-    -> Rec FieldRepr rs
-    -> Rec FieldRepr rs
+    :: f '(fn, ByField fn rs i)
+    -> Rec f rs
+    -> Rec f rs
 
 instance FElem fn ('(fn, r) ': rs) 'Z where
   type ByField fn ('(fn, r) ': rs) 'Z = r
@@ -98,8 +99,7 @@
 type Iso' s a = Iso s s a a
 
 iso
-  :: (s -> a)
-  -> (b -> t)
+  :: (s -> a) -> (b -> t)
   -> Iso s t a b
 iso sa bt = dimap sa (fmap bt)
 {-# INLINE iso #-}
@@ -116,24 +116,24 @@
   -- > fsubset :: Lens' (Rec FieldRepr ss) (Rec FieldRepr rs)
   fsubset
     :: Functor g
-    => (Rec FieldRepr rs -> g (Rec FieldRepr rs))
-    -> Rec FieldRepr ss
-    -> g (Rec FieldRepr ss)
+    => (Rec f rs -> g (Rec f rs))
+    -> Rec f ss
+    -> g (Rec f ss)
 
   -- | The getter of the 'fsubset' lens is 'fcast', which takes a larger record
   -- to a smaller one by forgetting fields.
   fcast
-    :: Rec FieldRepr ss
-    -> Rec FieldRepr rs
+    :: Rec f ss
+    -> Rec f rs
   fcast = getConst . fsubset Const
   {-# INLINE fcast #-}
 
   -- | The setter of the 'fsubset' lens is 'freplace', which allows a slice of
   -- a record to be replaced with different values.
   freplace
-    :: Rec FieldRepr rs
-    -> Rec FieldRepr ss
-    -> Rec FieldRepr ss
+    :: Rec f rs
+    -> Rec f ss
+    -> Rec f ss
   freplace rs = getIdentity . fsubset (\_ -> Identity rs)
   {-# INLINE freplace #-}
 
@@ -146,7 +146,7 @@
   , FSubset rs ss is) => FSubset ( '(fn,s) ': rs) ss (i ': is) where
   fsubset = lens (\ss -> fget Proxy ss :& fcast ss) set
     where
-      set :: Rec FieldRepr ss -> Rec FieldRepr ( '(fn,s) ': rs) -> Rec FieldRepr ss
+      set :: Rec f ss -> Rec f ( '(fn,s) ': rs) -> Rec f ss
       set ss (r :& rs) = fput r $ freplace rs ss
 
 -- A bunch of @Iso@morphisms
@@ -182,3 +182,8 @@
 
 obj :: (SingI fields) => Iso' (JsonRepr ('SchemaObject fields)) (Rec FieldRepr fields)
 obj = iso (\(ReprObject r) -> r) ReprObject
+
+arr
+  :: (SingI schema)
+  => Iso' (JsonRepr ('SchemaArray cs schema)) (V.Vector (JsonRepr schema))
+arr = iso (\(ReprArray r) -> r) ReprArray
diff --git a/src/Data/Schematic/Migration.hs b/src/Data/Schematic/Migration.hs
--- a/src/Data/Schematic/Migration.hs
+++ b/src/Data/Schematic/Migration.hs
@@ -5,6 +5,7 @@
 
 import Data.Kind
 import Data.Schematic.Path
+import Data.Tagged
 import Data.Schematic.Schema
 import Data.Singletons.Prelude hiding (All)
 import Data.Singletons.TypeLits
@@ -138,12 +139,13 @@
     -> Sing (ms :: [Migration]) -- a bunch of migrations
     -> Sing ('Versioned s ms)
 
+type DataMigration s m h = Tagged s (JsonRepr h -> m (JsonRepr s))
+
 data MList :: (* -> *) -> [Schema] -> Type where
   MNil :: (Monad m, SingI s, TopLevel s) => MList m '[s]
   (:&&)
     :: (TopLevel s, SingI s)
-    => proxy s
-    -> (JsonRepr h -> m (JsonRepr s))
+    => DataMigration s m h
     -> MList m (h ': tl)
     -> MList m (s ': h ': tl)
 
diff --git a/src/Data/Schematic/Path.hs b/src/Data/Schematic/Path.hs
--- a/src/Data/Schematic/Path.hs
+++ b/src/Data/Schematic/Path.hs
@@ -2,7 +2,6 @@
 
 import Data.Foldable as F
 import Data.Monoid
-import Data.Schematic.Utils
 import Data.Singletons
 import Data.Singletons.Prelude
 import Data.Singletons.TypeLits
@@ -12,16 +11,8 @@
 data PathSegment = Key Symbol | Ix Nat
 
 data instance Sing (jp :: PathSegment) where
-  SKey :: (KnownSymbol k, Known (Sing k)) => Sing (k :: Symbol) -> Sing ('Key k)
-  SIx :: (KnownNat n, Known (Sing n)) => Sing (n :: Nat) -> Sing ('Ix n)
-
-instance (KnownSymbol k, Known (Sing k))
-  => Known (Sing ('Key k)) where
-  known = SKey known
-
-instance (KnownNat n, Known (Sing n))
-  => Known (Sing ('Ix n)) where
-  known = SIx known
+  SKey :: (SingI k) => Sing (k :: Symbol) -> Sing ('Key k)
+  SIx :: (SingI n) => Sing (n :: Nat) -> Sing ('Ix n)
 
 data DemotedPathSegment = DKey Text | DIx Integer
   deriving (Show)
@@ -37,8 +28,8 @@
     go acc SNil = acc
     go acc (SCons p ps) = go (acc ++ [demote p]) ps
     demote :: Sing (ps :: PathSegment) -> DemotedPathSegment
-    demote (SKey s) = DKey $ T.pack $ symbolVal s
-    demote (SIx n) = DIx $ natVal n
+    demote (SKey s) = DKey $ T.pack $ withKnownSymbol s $ symbolVal s
+    demote (SIx n) = DIx $ withKnownNat n $ natVal n
 
 demotedPathToText :: [DemotedPathSegment] -> JSONPath
 demotedPathToText = JSONPath . F.foldl' renderPathSegment ""
diff --git a/src/Data/Schematic/Schema.hs b/src/Data/Schematic/Schema.hs
--- a/src/Data/Schematic/Schema.hs
+++ b/src/Data/Schematic/Schema.hs
@@ -5,7 +5,7 @@
 
 module Data.Schematic.Schema where
 
-import           Control.Applicative ()
+import           Control.Applicative ((<|>))
 import           Control.Monad
 import           Data.Aeson as J
 import           Data.Aeson.Types as J
@@ -14,13 +14,15 @@
 import           Data.Maybe
 import           Data.Schematic.Instances ()
 import           Data.Scientific
-import           Data.Singletons.Prelude.List hiding (All)
+import           Data.Singletons.Prelude.List hiding (All, Union)
 import           Data.Singletons.TH
 import           Data.Singletons.TypeLits
 import           Data.Text as T
+import           Data.Union
 import           Data.Vector as V
 import           Data.Vinyl hiding (Dict)
 import qualified Data.Vinyl.TypeLevel as V
+import           GHC.Exts
 import           GHC.Generics (Generic)
 import           GHC.TypeLits (SomeNat(..), SomeSymbol(..), someSymbolVal, someNatVal)
 import           Prelude as P
@@ -205,6 +207,7 @@
   | SchemaArray [ArrayConstraint] Schema
   | SchemaNull
   | SchemaOptional Schema
+  | SchemaUnion [Schema]
   deriving (Generic)
 
 data DemotedSchema
@@ -215,6 +218,7 @@
   | DSchemaArray [DemotedArrayConstraint] DemotedSchema
   | DSchemaNull
   | DSchemaOptional DemotedSchema
+  | DSchemaUnion [DemotedSchema]
   deriving (Generic)
 
 data instance Sing (schema :: Schema) where
@@ -225,6 +229,7 @@
   SSchemaObject :: Sing fields -> Sing ('SchemaObject fields)
   SSchemaOptional :: Sing s -> Sing ('SchemaOptional s)
   SSchemaNull :: Sing 'SchemaNull
+  SSchemaUnion :: Sing ss -> Sing ('SchemaUnion ss)
 
 instance SingI sl => SingI ('SchemaText sl) where
   sing = SSchemaText sing
@@ -240,6 +245,8 @@
   sing = SSchemaObject sing
 instance SingI s => SingI ('SchemaOptional s) where
   sing = SSchemaOptional sing
+instance SingI s => SingI ('SchemaUnion s) where
+  sing = SSchemaUnion sing
 
 instance Eq (Sing ('SchemaText cs)) where _ == _ = True
 instance Eq (Sing ('SchemaNumber cs)) where _ == _ = True
@@ -248,6 +255,7 @@
 instance Eq (Sing ('SchemaArray as s)) where _ == _ = True
 instance Eq (Sing ('SchemaObject cs)) where _ == _ = True
 instance Eq (Sing ('SchemaOptional s)) where _ == _ = True
+instance Eq (Sing ('SchemaUnion s)) where _ == _ = True
 
 instance SingKind Schema where
   type Demote Schema = DemotedSchema
@@ -258,12 +266,8 @@
     SSchemaArray cs s -> DSchemaArray (fromSing cs) (fromSing s)
     SSchemaOptional s -> DSchemaOptional $ fromSing s
     SSchemaNull -> DSchemaNull
-    SSchemaObject cs -> let
-      dem :: Sing (s :: [(Symbol, Schema)]) -> [(Text, DemotedSchema)]
-      dem SNil              = []
-      dem (SCons (STuple2 ss ssch) fs) = withKnownSymbol ss
-        $ (T.pack (symbolVal ss), fromSing ssch) : dem fs
-      in DSchemaObject $ dem cs
+    SSchemaObject cs -> DSchemaObject $ fromSing cs
+    SSchemaUnion ss -> DSchemaUnion $ fromSing ss
   toSing = \case
     DSchemaText cs -> case toSing cs of
       SomeSing scs -> SomeSing $ SSchemaText scs
@@ -277,6 +281,8 @@
     DSchemaNull -> SomeSing SSchemaNull
     DSchemaObject cs -> case toSing cs of
       SomeSing scs -> SomeSing $ SSchemaObject scs
+    DSchemaUnion ss -> case toSing ss of
+      SomeSing sss -> SomeSing $ SSchemaUnion sss
 
 data FieldRepr :: (Symbol, Schema) -> Type where
   FieldRepr
@@ -314,6 +320,10 @@
   => Serial m (FieldRepr '(name, schema)) where
   series = FieldRepr <$> series
 
+type family USubsets (u :: [k]) :: Constraint where
+  USubsets '[] = ()
+  USubsets (h ': tl) = (USubset tl (h ': tl) (V.RImage tl (h ': tl)), USubsets tl)
+
 data JsonRepr :: Schema -> Type where
   ReprText :: Text -> JsonRepr ('SchemaText cs)
   ReprNumber :: Scientific -> JsonRepr ('SchemaNumber cs)
@@ -322,7 +332,9 @@
   ReprArray :: V.Vector (JsonRepr s) -> JsonRepr ('SchemaArray cs s)
   ReprObject :: Rec FieldRepr fs -> JsonRepr ('SchemaObject fs)
   ReprOptional :: Maybe (JsonRepr s) -> JsonRepr ('SchemaOptional s)
+  ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr ('SchemaUnion (h ': tl))
 
+-- | Move to the union package
 instance Show (JsonRepr ('SchemaText cs)) where
   show (ReprText t) = "ReprText " P.++ show t
 
@@ -381,6 +393,22 @@
 instance Eq (JsonRepr s) => Eq (JsonRepr ('SchemaOptional s)) where
   ReprOptional a == ReprOptional b = a == b
 
+instance IsList (JsonRepr ('SchemaArray cs s)) where
+  type Item (JsonRepr ('SchemaArray cs s)) = JsonRepr s
+  fromList = ReprArray . GHC.Exts.fromList
+  toList (ReprArray v) = GHC.Exts.toList v
+
+instance Num (JsonRepr ('SchemaNumber cs)) where
+  ReprNumber a + ReprNumber b = ReprNumber $ a + b
+  ReprNumber a - ReprNumber b = ReprNumber $ a - b
+  ReprNumber a * ReprNumber b = ReprNumber $ a * b
+  abs (ReprNumber a) = ReprNumber $ abs a
+  signum (ReprNumber a) = ReprNumber $ signum a
+  fromInteger = ReprNumber . fromIntegral
+
+instance IsString (JsonRepr ('SchemaText cs)) where
+  fromString = ReprText . fromString
+
 fromOptional
   :: SingI s
   => Sing ('SchemaOptional s)
@@ -388,6 +416,24 @@
   -> Parser (Maybe (JsonRepr s))
 fromOptional _ = parseJSON
 
+parseUnion
+  :: FromJSON (JsonRepr ('SchemaUnion ss))
+  => sing (ss :: [Schema])
+  -> Value
+  -> Parser (JsonRepr ('SchemaUnion ss))
+parseUnion _ val = parseJSON val
+
+instance FromJSON (Union JsonRepr '[]) where
+  parseJSON = fail "empty union"
+
+instance (SingI a, FromJSON (Union JsonRepr as)) => FromJSON (Union JsonRepr (a ': as)) where
+  parseJSON val = (This <$> parseJSON val)
+    <|> (That <$> (parseJSON val :: Parser (Union JsonRepr as)))
+
+instance ToJSON (Union JsonRepr as) where
+  toJSON (This fa) = toJSON fa
+  toJSON (That u)  = toJSON u
+
 instance SingI schema => J.FromJSON (JsonRepr schema) where
   parseJSON value = case sing :: Sing schema of
     SSchemaText _          -> withText "String" (pure . ReprText) value
@@ -427,8 +473,10 @@
             SSchemaOptional so -> case H.lookup fieldName h of
               Just v -> withSingI so $ FieldRepr <$> parseJSON v
               Nothing -> fail "schemaoptional"
+            SSchemaUnion ss -> withSingI ss $ FieldRepr <$> parseUnion ss value
           (fieldRepr :&) <$> demoteFields tl h
       ReprObject <$> withObject "Object" (demoteFields fs) value
+    SSchemaUnion ss -> parseUnion ss value
 
 instance J.ToJSON (JsonRepr a) where
   toJSON ReprNull         = J.Null
@@ -449,6 +497,7 @@
       fold = \case
         RNil                   -> []
         fr@(FieldRepr _) :& tl -> (extract fr) : fold tl
+  toJSON (ReprUnion u) = toJSON u
 
 class FalseConstraint a
 
diff --git a/src/Data/Schematic/Utils.hs b/src/Data/Schematic/Utils.hs
deleted file mode 100644
--- a/src/Data/Schematic/Utils.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-
-module Data.Schematic.Utils where
-
-import Data.Proxy
-import Data.Singletons
-import Data.Singletons.Prelude
-import Data.Singletons.TypeLits
-import Data.Vinyl hiding (Dict)
-
-
-class Known a where
-  known :: a
-
-instance Known (Proxy a) where
-  known = Proxy
-
-instance KnownNat n => Known (Sing n) where
-  known = SNat
-
-instance KnownSymbol s => Known (Sing s) where
-  known = SSym
-
-instance (Known (Sing a), Known (Sing b)) => Known (Sing '(a,b)) where
-  known = STuple2 known known
-
-instance Known (Sing '[]) where known = SNil
-
-instance (Known (Sing a), Known (Sing as)) => Known (Sing (a ': as)) where
-  known = SCons known known
-
-instance Known (Rec Sing '[]) where
-  known = RNil
-
-instance (Known (Sing a), Known (Rec Sing tl)) => Known (Rec Sing (a ': tl)) where
-  known = known :& known
-
-data Dict c where
-  Dict :: c => Dict c
-
-instance c => Known (Dict c) where
-  known = Dict
diff --git a/src/Data/Schematic/Validation.hs b/src/Data/Schematic/Validation.hs
--- a/src/Data/Schematic/Validation.hs
+++ b/src/Data/Schematic/Validation.hs
@@ -7,14 +7,15 @@
 import Data.Monoid
 import Data.Schematic.Path
 import Data.Schematic.Schema
-import Data.Schematic.Utils ()
 import Data.Scientific
 import Data.Singletons.Prelude
 import Data.Singletons.TypeLits
 import Data.Text as T
 import Data.Traversable
+import Data.Union
 import Data.Vector as V
 import Data.Vinyl
+import Data.Vinyl.TypeLevel
 import Prelude as P
 import Text.Regex.TDFA
 
@@ -199,9 +200,49 @@
   ReprObject fs -> case sschema of
     SSchemaObject _ -> go fs
       where
-        go :: Rec FieldRepr (ts :: [ (Symbol, Schema) ] ) -> Validation ()
+        go :: Rec FieldRepr (ts :: [(Symbol, Schema)] ) -> Validation ()
         go RNil                     = pure ()
         go (f@(FieldRepr d) :& ftl) = do
           let newPath = dpath <> [DKey (knownFieldName f)]
           validateJsonRepr (knownFieldSchema f) newPath d
           go ftl
+  ReprUnion _ -> pure () -- FIXME
+    -- case sschema of
+    --   SSchemaUnion ss -> case ss of
+    --     SCons s stl -> case umatch' s u of
+    --       Nothing -> case urestrict u of
+    --         Nothing ->
+    --           fail "impossible to produce subUnion, please report this as a bug"
+    --         Just x -> do
+    --           let
+    --             JSONPath path = demotedPathToText dpath
+    --           case stl of
+    --             SNil -> void $ vWarning $ mmSingleton path
+    --               $ pure "union handling error, please report this as bug"
+    --             SCons s' stl' ->
+    --               validateJsonRepr (SSchemaUnion (SCons s' stl')) dpath
+    --                 $ toUnion (SCons s' stl') x
+    --       Just x  -> validateJsonRepr s dpath x
+
+-- subUnion
+--   :: Sing (s ': stl)
+--   -> (  USubset stl (s ': stl) (RImage stl (s ': stl))
+--      => Union f (s ': stl)
+--      -> Maybe (Union f stl) )
+-- subUnion (SCons s stl) = urestrict
+
+-- withUSubset
+--   :: Sing (s ': stl)
+--   -> (USubset stl (s ': stl) (RImage stl (s ': stl)) => Maybe (Union f stl))
+--   -> Maybe (Union f stl)
+-- withUSubset (SCons s stl) r = r
+
+toUnion
+  :: USubset s' (s ': ss) (RImage s' (s ': ss))
+  => Sing (s ': ss)
+  -> Union JsonRepr s'
+  -> JsonRepr ('SchemaUnion (s ': ss))
+toUnion _ = ReprUnion . urelax
+
+umatch' :: UElem a as i => Sing a -> Union f as -> Maybe (f a)
+umatch' _ u = umatch u
diff --git a/test/HelpersSpec.hs b/test/HelpersSpec.hs
--- a/test/HelpersSpec.hs
+++ b/test/HelpersSpec.hs
@@ -3,18 +3,12 @@
 module HelpersSpec (spec, main) where
 
 import Control.Lens
-import Data.Aeson
-import Data.ByteString.Char8 as C8
-import Data.ByteString.Lazy as BL
 import Data.ByteString.Lazy.Lens
 import Data.Foldable
-import Data.Functor.Identity
 import Data.Monoid
-import Data.Proxy
 import Data.Schematic
 import Data.Text as T
 import Data.Text.Lens
-import Data.Vinyl
 import Test.Hspec
 
 
diff --git a/test/JsonSchemaSpec.hs b/test/JsonSchemaSpec.hs
--- a/test/JsonSchemaSpec.hs
+++ b/test/JsonSchemaSpec.hs
@@ -1,6 +1,7 @@
 module JsonSchemaSpec (spec, main) where
 
 import Data.Aeson as J
+import Data.Maybe
 import Data.Proxy
 import Data.Schematic
 import Data.Vinyl
@@ -17,24 +18,16 @@
 
 type SchemaExample = 'SchemaObject FieldsSchema
 
-arrayData :: JsonRepr ArraySchema
-arrayData = ReprArray [ReprNumber 13]
-
-arrayField :: FieldRepr ArrayField
-arrayField = FieldRepr arrayData
-
-objectData :: Rec FieldRepr FieldsSchema
-objectData = FieldRepr arrayData
-  :& FieldRepr (ReprOptional (Just (ReprText "foo")))
-  :& RNil
-
 exampleData :: JsonRepr SchemaExample
-exampleData = ReprObject objectData
+exampleData = withRepr @SchemaExample $
+     field @"foo" [ReprNumber 13]
+  :& field @"bar" (pure (ReprText "foo"))
+  :& RNil
 
 spec :: Spec
 spec = do
   it "validates simple schema" $ do
-    let schema = D4.SchemaWithURI (toJsonSchema (Proxy @SchemaExample)) Nothing
+    let schema = D4.SchemaWithURI (fromJust $ toJsonSchema (Proxy @SchemaExample)) Nothing
     fetchHTTPAndValidate schema (toJSON exampleData) >>= \case
       Left _ -> fail "failed to validate test example"
       Right _ -> pure ()
diff --git a/test/LensSpec.hs b/test/LensSpec.hs
--- a/test/LensSpec.hs
+++ b/test/LensSpec.hs
@@ -1,7 +1,6 @@
 module LensSpec (spec, main) where
 
 import Control.Lens
-import Data.Kind
 import Data.Proxy
 import Data.Schematic
 import Data.Vinyl
@@ -15,8 +14,6 @@
 type FieldsSchema =
   '[ '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]])), ArrayField]
 
-type SchemaExample = 'SchemaObject FieldsSchema
-
 arrayData :: JsonRepr ArraySchema
 arrayData = ReprArray [ReprNumber 13]
 
@@ -27,9 +24,6 @@
 objectData = FieldRepr (ReprOptional (Just (ReprText "foo")))
   :& FieldRepr arrayData
   :& RNil
-
-exampleData :: JsonRepr SchemaExample
-exampleData = ReprObject objectData
 
 type BigRecord = Rec FieldRepr
   '[ '("f1", 'SchemaNumber '[])
diff --git a/test/SchemaSpec.hs b/test/SchemaSpec.hs
--- a/test/SchemaSpec.hs
+++ b/test/SchemaSpec.hs
@@ -7,15 +7,21 @@
 import Data.Functor.Identity
 import Data.Proxy
 import Data.Schematic
+import Data.Tagged
 import Data.Vinyl
 import Test.Hspec
 
 
-type SchemaExample
-  = 'SchemaObject
-    '[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10]))
-     , '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
+type SchemaExample = 'SchemaObject
+  '[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10]))
+   , '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
 
+jsonExample :: JsonRepr SchemaExample
+jsonExample = withRepr @SchemaExample
+   $ field @"bar" (Just "bar")
+  :& field @"foo" [12]
+  :& RNil
+
 type TestMigration =
   'Migration "test_revision"
     '[ 'Diff '[ 'PKey "bar" ] ('Update ('SchemaText '[]))
@@ -23,12 +29,6 @@
 
 type VS = 'Versioned SchemaExample '[ TestMigration ]
 
-jsonExample :: JsonRepr SchemaExample
-jsonExample = ReprObject $
-  FieldRepr (ReprArray [ReprNumber 12])
-    :& FieldRepr (ReprOptional (Just (ReprText "bar")))
-    :& RNil
-
 schemaJson :: ByteString
 schemaJson = "{\"foo\": [13], \"bar\": null}"
 
@@ -66,9 +66,7 @@
   it "validates versioned json with a migration list" $ do
     decodeAndValidateVersionedWithPureMList
       (Proxy @VS)
-      ((:&&)
-        (Proxy @(SchemaByRevision "test_revision" VS))
-        (const $ Identity topObject) MNil)
+      (Tagged (const $ Identity topObject) :&& MNil)
       schemaJson
         `shouldSatisfy` isValid