diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# 0
+
+Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Fumiaki Kinoshita (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Fumiaki Kinoshita nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,116 @@
+# winery
+
+winery is a serialisation library for Haskell. It tries to achieve two
+goals: compact representation and perpetual inspectability.
+
+The `binary` library provides a compact representation, but there is no way to
+inspect the serialised value without the original instance.
+
+There's `serialise`, which is an alternative library based on CBOR. Every value has to be accompanied with tags, so it tends to be redundant for arrays of small values. Encoding records with field names is also redudant.
+
+## Interface
+
+The interface is simple; `serialise` encodes a value with its schema, and
+`deserialise` decodes a ByteString using the schema in it.
+
+```haskell
+class Serialise a
+
+serialise :: Serialise a => a -> B.ByteString
+deserialise :: Serialise a => B.ByteString -> Either String a
+```
+
+It's also possible to serialise schemata and data separately.
+
+```haskell
+-- Note that 'Schema' is an instance of 'Serialise'
+schema :: Serialise a => proxy a -> Schema
+serialiseOnly :: Serialise a => a -> B.ByteString
+```
+
+`getDecoder` gives you a deserialiser.
+
+```haskell
+getDecoder :: Serialise a => Schema -> Either StrategyError (ByteString -> a)
+```
+
+For user-defined datatypes, you can either define instances
+
+```haskell
+instance Serialise Foo where
+  schemaVia = gschemaViaRecord
+  toEncoding = gtoEncodingRecord
+  deserialiser = gdeserialiserRecord Nothing
+```
+
+for single-constructor records, or just
+
+```haskell
+instance Serialise Foo
+```
+
+for any ADT. The former explicitly describes field names in the schema, and the
+latter does constructor names.
+
+## The schema
+
+The definition of `Schema` is as follows:
+
+```haskell
+data Schema = SSchema !Word8
+  | SUnit
+  | SBool
+  | SChar
+  | SWord8
+  | SWord16
+  | SWord32
+  | SWord64
+  | SInt8
+  | SInt16
+  | SInt32
+  | SInt64
+  | SInteger
+  | SFloat
+  | SDouble
+  | SBytes
+  | SText
+  | SList !Schema
+  | SArray !(VarInt Int) !Schema -- fixed size
+  | SProduct [Schema]
+  | SProductFixed [(VarInt Int, Schema)] -- fixed size
+  | SRecord [(T.Text, Schema)]
+  | SVariant [(T.Text, [Schema])]
+  | SFix Schema -- ^ binds a fixpoint
+  | SSelf !Word8 -- ^ @SSelf n@ refers to the n-th innermost fixpoint
+  deriving (Show, Read, Eq, Generic)
+```
+
+The `Serialise` instance is derived by generics.
+
+There are some special schemata:
+
+* `SSchema n` is a schema of schema. The winery library stores the concrete schema of `Schema` for each version, so it can deserialise data even if the schema changes.
+* `SFix` binds a fixpoint.
+* `SSelf n` refers to the n-th innermost fixpoint bound by `SFix`. This allows it to provide schemata for inductive datatypes.
+
+## Backward compatibility
+
+If having default values for missing fields is sufficient, you can pass a
+default value to `gdeserialiserRecord`:
+
+```haskell
+  deserialiser = gdeserialiserRecord $ Just $ Foo "" 42 0
+```
+
+You can also build a custom deserialiser using the Alternative instance and combinators such as `extractField`, `extractConstructor`, etc.
+
+## Pretty-printing
+
+`Term` can be deserialised from any winery data. It can be pretty-printed using the `Pretty` instance:
+
+```
+{ bar: "hello"
+, baz: 3.141592653589793
+, foo: Just 42
+}
+```
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE LambdaCase #-}
+module Main where
+
+import Control.Monad
+import qualified Data.ByteString as B
+import Data.Text.Prettyprint.Doc
+import Data.Text.Prettyprint.Doc.Render.Terminal
+import Data.Winery.Term
+import Data.Winery
+import System.Console.GetOpt
+import System.Environment
+import System.Exit
+import System.IO
+
+data Options = Options
+  { streamInput :: Bool
+  , separateSchema :: Maybe (Maybe FilePath)
+  , printSchema :: Bool
+  }
+
+defaultOptions :: Options
+defaultOptions = Options
+  { streamInput = False
+  , printSchema = False
+  , separateSchema = Nothing
+  }
+
+options :: [OptDescr (Options -> Options)]
+options =
+  [ Option "s" ["stream"] (NoArg $ \o -> o { streamInput = True }) "stream input"
+  , Option "S" ["separate-schema"] (OptArg (\s o -> o { separateSchema = Just s }) "PATH") "the schema is separated"
+  , Option "" ["print-schema"] (NoArg $ \o -> o { printSchema = True }) "print the schema"
+  ]
+
+getRight :: Either StrategyError a -> IO a
+getRight (Left err) = do
+  hPutDoc stderr err
+  exitFailure
+getRight (Right a) = return a
+
+main = getOpt Permute options <$> getArgs >>= \case
+  (fs, _, []) -> do
+    let o = foldl (flip id) defaultOptions fs
+
+    printer <- case separateSchema o of
+      Just mpath -> do
+        bs <- maybe (readLn >>= B.hGet stdin) B.readFile mpath
+        sch <- getRight $ deserialise bs
+        when (printSchema o) $ putDoc $ pretty sch <> hardline
+        dec <- getRight $ getDecoderBy decodeTerm sch
+        return $ \bs -> putDoc $ pretty (dec bs) <> hardline
+      Nothing -> return $ \bs -> do
+        (s, t) <- getRight $ deserialiseTerm bs
+        when (printSchema o) $ putDoc $ pretty s <> hardline
+        putDoc $ pretty t <> hardline
+
+    case streamInput o of
+      False -> B.hGetContents stdin >>= printer
+      True -> forever $ do
+        n <- readLn
+        B.hGet stdin n >>= printer
+  (_, _, es) -> do
+    name <- getProgName
+    die $ unlines es ++ usageInfo name options
diff --git a/src/Data/Winery.hs b/src/Data/Winery.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Winery.hs
@@ -0,0 +1,867 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module Data.Winery
+  ( Schema(..)
+  , Serialise(..)
+  , schema
+  -- * Standalone serialisation
+  , serialise
+  , deserialise
+  -- * Separate serialisation
+  , Deserialiser(..)
+  , Decoder
+  , serialiseOnly
+  , getDecoder
+  , getDecoderBy
+  -- * Encoding combinators
+  , Encoding
+  , encodeMulti
+  -- * Decoding combinators
+  , Plan(..)
+  , extractListWith
+  , extractField
+  , extractFieldWith
+  , extractConstructor
+  , extractConstructorWith
+  -- * Variable-length quantity
+  , VarInt(..)
+  -- * Internal
+  , unwrapDeserialiser
+  , Strategy
+  , StrategyError
+  -- * Generics
+  , GSerialiseRecord
+  , gschemaViaRecord
+  , gtoEncodingRecord
+  , gdeserialiserRecord
+  , GSerialiseVariant
+  , gschemaViaVariant
+  , gtoEncodingVariant
+  , gdeserialiserVariant
+  -- * Preset schema
+  , bootstrapSchema
+  )where
+
+import Control.Applicative
+import Control.Monad.Trans.Cont
+import Control.Monad.Reader
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Builder as BB
+import Data.Bits
+import Data.Dynamic
+import Data.Functor.Identity
+import Data.Foldable
+import Data.Proxy
+import Data.Hashable (Hashable)
+import qualified Data.HashMap.Strict as HM
+import Data.Int
+import qualified Data.IntMap as IM
+import qualified Data.IntSet as IS
+import Data.List (elemIndex)
+import qualified Data.Map as M
+import Data.Monoid
+import Data.Word
+import Data.Winery.Internal
+import qualified Data.Sequence as Seq
+import qualified Data.Set as S
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Vector as V
+import qualified Data.Vector.Storable as SV
+import qualified Data.Vector.Unboxed as UV
+import Data.Text.Prettyprint.Doc hiding ((<>), SText, SChar)
+import Data.Text.Prettyprint.Doc.Render.Terminal
+import Data.Typeable
+import GHC.Generics
+import Unsafe.Coerce
+
+data Schema = SSchema !Word8
+  | SUnit
+  | SBool
+  | SChar
+  | SWord8
+  | SWord16
+  | SWord32
+  | SWord64
+  | SInt8
+  | SInt16
+  | SInt32
+  | SInt64
+  | SInteger
+  | SFloat
+  | SDouble
+  | SBytes
+  | SText
+  | SList !Schema
+  | SArray !(VarInt Int) !Schema -- fixed size
+  | SProduct [Schema]
+  | SProductFixed [(VarInt Int, Schema)] -- fixed size
+  | SRecord [(T.Text, Schema)]
+  | SVariant [(T.Text, [Schema])]
+  | SFix Schema -- ^ binds a fixpoint
+  | SSelf !Word8 -- ^ @SSelf n@ refers to the n-th innermost fixpoint
+  deriving (Show, Read, Eq, Generic)
+
+instance Pretty Schema where
+  pretty = \case
+    SSchema v -> "Schema " <> pretty v
+    SUnit -> "()"
+    SBool -> "Bool"
+    SChar -> "Char"
+    SWord8 -> "Word8"
+    SWord16 -> "Word16"
+    SWord32 -> "Word32"
+    SWord64 -> "Word64"
+    SInt8 -> "Int8"
+    SInt16 -> "Int16"
+    SInt32 -> "Int32"
+    SInt64 -> "Int64"
+    SInteger -> "Integer"
+    SFloat -> "Float"
+    SDouble -> "Double"
+    SBytes -> "ByteString"
+    SText -> "Text"
+    SList s -> "[" <> pretty s <> "]"
+    SArray _ s -> "[" <> pretty s <> "]"
+    SProduct ss -> tupled $ map pretty ss
+    SProductFixed ss -> tupled $ map (pretty . snd) ss
+    SRecord ss -> align $ encloseSep "{ " " }" ", " [pretty k <+> "::" <+> pretty v | (k, v) <- ss]
+    SVariant ss -> align $ encloseSep "( " " )" (flatAlt "| " " | ")
+      [ if null vs
+          then pretty k
+          else nest 2 $ sep $ pretty k : map pretty vs | (k, vs) <- ss]
+    SFix sch -> group $ nest 2 $ sep ["μ", pretty sch]
+    SSelf i -> "Self" <+> pretty i
+
+-- | 'Deserialiser' is a 'Plan' that creates a 'Decoder'.
+newtype Deserialiser a = Deserialiser { getDeserialiser :: Plan (Decoder a) }
+  deriving Functor
+
+instance Applicative Deserialiser where
+  pure = Deserialiser . pure . pure
+  Deserialiser f <*> Deserialiser x = Deserialiser $ (<*>) <$> f <*> x
+
+newtype Plan a = Plan { unPlan :: Schema -> Strategy a }
+  deriving Functor
+
+instance Applicative Plan where
+  pure = return
+  (<*>) = ap
+
+instance Monad Plan where
+  return = Plan . const . pure
+  m >>= k = Plan $ \sch -> Strategy $ \decs -> case unStrategy (unPlan m sch) decs of
+    Right a -> unStrategy (unPlan (k a) sch) decs
+    Left e -> Left e
+
+instance Alternative Plan where
+  empty = Plan $ const empty
+  Plan a <|> Plan b = Plan $ \s -> a s <|> b s
+
+unwrapDeserialiser :: Deserialiser a -> Schema -> Strategy (Decoder a)
+unwrapDeserialiser (Deserialiser m) = unPlan m
+{-# INLINE unwrapDeserialiser #-}
+
+-- | Serialisable datatype
+class Typeable a => Serialise a where
+  -- | Obtain the schema of the datatype. @[TypeRep]@ is for handling recursion.
+  schemaVia :: Proxy a -> [TypeRep] -> Schema
+
+  -- | Serialise a value.
+  toEncoding :: a -> Encoding
+
+  -- | The 'Deserialiser'
+  deserialiser :: Deserialiser a
+
+  -- | If this is @'Just' x@, the size of `toEncoding` must be @x@.
+  -- `deserialiser` must not depend on this value.
+  constantSize :: Proxy a -> Maybe Int
+  constantSize _ = Nothing
+
+  default schemaVia :: (Generic a, GSerialiseVariant (Rep a)) => Proxy a -> [TypeRep] -> Schema
+  schemaVia = gschemaViaVariant
+  default toEncoding :: (Generic a, GSerialiseVariant (Rep a)) => a -> Encoding
+  toEncoding = gtoEncodingVariant
+  default deserialiser :: (Generic a, GSerialiseVariant (Rep a)) => Deserialiser a
+  deserialiser = gdeserialiserVariant
+
+-- | Obtain the schema of the datatype.
+schema :: forall proxy a. Serialise a => proxy a -> Schema
+schema _ = schemaVia (Proxy :: Proxy a) []
+{-# INLINE schema #-}
+
+-- | Obtain a decoder from a schema.
+getDecoder :: Serialise a => Schema -> Either StrategyError (Decoder a)
+getDecoder = getDecoderBy deserialiser
+{-# INLINE getDecoder #-}
+
+-- | Get a decoder from a `Deserialiser` and a schema.
+getDecoderBy :: Deserialiser a -> Schema -> Either StrategyError (Decoder a)
+getDecoderBy (Deserialiser plan) sch = unPlan plan sch `unStrategy` []
+{-# INLINE getDecoderBy #-}
+
+-- | Serialise a value along with its schema.
+serialise :: Serialise a => a -> B.ByteString
+serialise a = BL.toStrict $ BB.toLazyByteString $ mappend (BB.word8 currentSchemaVersion)
+  $ snd $ toEncoding (schema [a], a)
+
+-- | Deserialise a 'serialise'd 'B.Bytestring'.
+deserialise :: Serialise a => B.ByteString -> Either StrategyError a
+deserialise bs_ = case B.uncons bs_ of
+  Just (ver, bs) -> do
+    m <- getDecoder $ SSchema ver
+    ($bs) $ evalContT $ do
+      offB <- decodeVarInt
+      sch <- lift m
+      asks $ \bs' -> ($ B.drop offB bs') <$> getDecoderBy deserialiser sch
+  Nothing -> Left "Unexpected empty string"
+
+-- | Serialise a value without its schema.
+serialiseOnly :: Serialise a => a -> B.ByteString
+serialiseOnly = BL.toStrict . BB.toLazyByteString . snd . toEncoding
+{-# INLINE serialiseOnly #-}
+
+substSchema :: Serialise a => Proxy a -> [TypeRep] -> Schema
+substSchema p ts
+  | Just i <- elemIndex (typeRep p) ts = SSelf $ fromIntegral i
+  | otherwise = schemaVia p ts
+
+currentSchemaVersion :: Word8
+currentSchemaVersion = 0
+
+bootstrapSchema :: Word8 -> Either StrategyError Schema
+bootstrapSchema 0 = Right $ SFix $ SVariant [("SSchema",[SWord8])
+  ,("SUnit",[])
+  ,("SBool",[])
+  ,("SChar",[])
+  ,("SWord8",[])
+  ,("SWord16",[])
+  ,("SWord32",[])
+  ,("SWord64",[])
+  ,("SInt8",[])
+  ,("SInt16",[])
+  ,("SInt32",[])
+  ,("SInt64",[])
+  ,("SInteger",[])
+  ,("SFloat",[])
+  ,("SDouble",[])
+  ,("SBytes",[])
+  ,("SText",[])
+  ,("SList",[SSelf 0])
+  ,("SArray",[SInteger, SSelf 0])
+  ,("SProduct",[SList (SSelf 0)])
+  ,("SProductFixed",[SList $ SProduct [SInteger, SSelf 0]])
+  ,("SRecord",[SList (SProduct [SText,SSelf 0])])
+  ,("SVariant",[SList (SProduct [SText,SList (SSelf 0)])])
+  ,("SFix",[SSelf 0])
+  ,("SSelf",[SWord8])
+  ]
+bootstrapSchema n = Left $ "Unsupported version: " <> pretty n
+
+unexpectedSchema :: forall a. Serialise a => Doc AnsiStyle -> Schema -> Strategy (Decoder a)
+unexpectedSchema subject actual = unexpectedSchema' subject
+  (pretty $ schema (Proxy :: Proxy a)) actual
+
+unexpectedSchema' :: Doc AnsiStyle -> Doc AnsiStyle -> Schema -> Strategy a
+unexpectedSchema' subject expected actual = errorStrategy
+  $ annotate bold subject
+  <+> "expects" <+> annotate (color Green <> bold) expected
+  <+> "but got " <+> pretty actual
+
+instance Serialise Schema where
+  schemaVia _ _ = SSchema currentSchemaVersion
+  toEncoding = gtoEncodingVariant
+  deserialiser = Deserialiser $ Plan $ \case
+    SSchema n -> Strategy (const $ bootstrapSchema n)
+      >>= unwrapDeserialiser gdeserialiserVariant
+    s -> unwrapDeserialiser gdeserialiserVariant s
+
+instance Serialise () where
+  schemaVia _ _ = SUnit
+  toEncoding = mempty
+  deserialiser = pure ()
+  constantSize _ = Just 0
+
+instance Serialise Bool where
+  schemaVia _ _ = SBool
+  toEncoding False = (1, BB.word8 0)
+  toEncoding True = (1, BB.word8 1)
+  deserialiser = Deserialiser $ Plan $ \case
+    SBool -> pure $ (/=0) <$> evalContT getWord8
+    s -> unexpectedSchema "Serialise Bool" s
+  constantSize _ = Just 1
+
+instance Serialise Word8 where
+  schemaVia _ _ = SWord8
+  toEncoding x = (1, BB.word8 x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SWord8 -> pure $ evalContT getWord8
+    s -> unexpectedSchema "Serialise Word8" s
+  constantSize _ = Just 1
+
+instance Serialise Word16 where
+  schemaVia _ _ = SWord16
+  toEncoding x = (2, BB.word16BE x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SWord16 -> pure $ evalContT $ do
+      a <- getWord8
+      b <- getWord8
+      return $! fromIntegral a `unsafeShiftL` 8 .|. fromIntegral b
+    s -> unexpectedSchema "Serialise Word16" s
+  constantSize _ = Just 2
+
+instance Serialise Word32 where
+  schemaVia _ _ = SWord32
+  toEncoding x = (4, BB.word32BE x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SWord32 -> pure word32be
+    s -> unexpectedSchema "Serialise Word32" s
+  constantSize _ = Just 4
+
+instance Serialise Word64 where
+  schemaVia _ _ = SWord64
+  toEncoding x = (8, BB.word64BE x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SWord64 -> pure word64be
+    s -> unexpectedSchema "Serialise Word64" s
+  constantSize _ = Just 8
+
+instance Serialise Word where
+  schemaVia _ _ = SWord64
+  toEncoding x = (8, BB.word64BE $ fromIntegral x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SWord64 -> pure $ fromIntegral <$> word64be
+    s -> unexpectedSchema "Serialise Word" s
+  constantSize _ = Just 8
+
+instance Serialise Int8 where
+  schemaVia _ _ = SInt8
+  toEncoding x = (1, BB.int8 x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SInt8 -> pure $ fromIntegral <$> evalContT getWord8
+    s -> unexpectedSchema "Serialise Int8" s
+  constantSize _ = Just 1
+
+instance Serialise Int16 where
+  schemaVia _ _ = SInt16
+  toEncoding x = (2, BB.int16BE x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SInt16 -> pure $ fromIntegral <$> word16be
+    s -> unexpectedSchema "Serialise Int16" s
+  constantSize _ = Just 2
+
+instance Serialise Int32 where
+  schemaVia _ _ = SInt32
+  toEncoding x = (4, BB.int32BE x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SInt32 -> pure $ fromIntegral <$> word32be
+    s -> unexpectedSchema "Serialise Int32" s
+  constantSize _ = Just 4
+
+instance Serialise Int64 where
+  schemaVia _ _ = SInt64
+  toEncoding x = (8, BB.int64BE x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SInt64 -> pure $ fromIntegral <$> word64be
+    s -> unexpectedSchema "Serialise Int64" s
+  constantSize _ = Just 8
+
+instance Serialise Int where
+  schemaVia _ _ = SInteger
+  toEncoding = toEncoding . VarInt
+  deserialiser = Deserialiser $ Plan $ \case
+    SInteger -> pure $ getVarInt . evalContT decodeVarInt
+    s -> unexpectedSchema "Serialise Int" s
+
+instance Serialise Float where
+  schemaVia _ _ = SFloat
+  toEncoding x = (4, BB.word32BE $ unsafeCoerce x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SFloat -> pure $ unsafeCoerce <$> word32be
+    s -> unexpectedSchema "Serialise Float" s
+  constantSize _ = Just 4
+
+instance Serialise Double where
+  schemaVia _ _ = SDouble
+  toEncoding x = (8, BB.word64BE $ unsafeCoerce x)
+  deserialiser = Deserialiser $ Plan $ \case
+    SDouble -> pure $ unsafeCoerce <$> word64be
+    s -> unexpectedSchema "Serialise Double" s
+  constantSize _ = Just 8
+
+instance Serialise T.Text where
+  schemaVia _ _ = SText
+  toEncoding = toEncoding . T.encodeUtf8
+  deserialiser = Deserialiser $ Plan $ \case
+    SText -> pure $ T.decodeUtf8 <$> getBytes
+    s -> unexpectedSchema "Serialise Text" s
+
+-- | Encoded in variable-length quantity.
+newtype VarInt a = VarInt { getVarInt :: a } deriving (Show, Read, Eq, Ord, Enum
+  , Bounded, Num, Real, Integral, Bits, Typeable)
+
+instance (Typeable a, Integral a, Bits a) => Serialise (VarInt a) where
+  schemaVia _ _ = SInteger
+  toEncoding = encodeVarInt
+  deserialiser = Deserialiser $ Plan $ \case
+    SInteger -> pure $ evalContT decodeVarInt
+    s -> unexpectedSchema "Serialise (VarInt a)" s
+
+instance Serialise Integer where
+  schemaVia _ _ = SInteger
+  toEncoding = toEncoding . VarInt
+  deserialiser = getVarInt <$> deserialiser
+
+instance Serialise Char where
+  schemaVia _ _ = SChar
+  toEncoding = toEncoding . fromEnum
+  deserialiser = Deserialiser $ Plan $ \case
+    SChar -> pure $ toEnum . evalContT decodeVarInt
+    s -> unexpectedSchema "Serialise Char" s
+
+instance Serialise a => Serialise (Maybe a) where
+  schemaVia _ ts = SVariant [("Nothing", [])
+    , ("Just", [substSchema (Proxy :: Proxy a) ts])]
+  toEncoding Nothing = encodeVarInt (0 :: Word8)
+  toEncoding (Just a) = encodeVarInt (1 :: Word8) <> toEncoding a
+  deserialiser = Deserialiser $ Plan $ \case
+    SVariant [_, (_, [sch])] -> do
+      dec <- unwrapDeserialiser deserialiser sch
+      return $ evalContT $ do
+        t <- decodeVarInt
+        case t :: Word8 of
+          0 -> pure Nothing
+          _ -> Just <$> lift dec
+    s -> unexpectedSchema "Serialise (Maybe a)" s
+  constantSize _ = (1+) <$> constantSize (Proxy :: Proxy a)
+
+instance Serialise B.ByteString where
+  schemaVia _ _ = SBytes
+  toEncoding bs = encodeVarInt (B.length bs)
+    <> (Sum $ B.length bs, BB.byteString bs)
+  deserialiser = Deserialiser $ Plan $ \case
+    SBytes -> pure getBytes
+    s -> unexpectedSchema "Serialise ByteString" s
+
+instance Serialise a => Serialise [a] where
+  schemaVia _ ts = case constantSize (Proxy :: Proxy a) of
+    Nothing -> SList (substSchema (Proxy :: Proxy a) ts)
+    Just s -> SArray (VarInt s) (substSchema (Proxy :: Proxy a) ts)
+  toEncoding xs = case constantSize (Proxy :: Proxy a) of
+    Nothing -> encodeVarInt (length xs)
+      <> encodeMulti (map toEncoding xs)
+    Just _ -> encodeVarInt (length xs) <> foldMap toEncoding xs
+  deserialiser = extractListWith deserialiser
+
+instance Serialise a => Serialise (V.Vector a) where
+  schemaVia _ = schemaVia (Proxy :: Proxy [a])
+  toEncoding = toEncoding . V.toList
+  deserialiser = V.fromList <$> deserialiser
+
+instance (SV.Storable a, Serialise a) => Serialise (SV.Vector a) where
+  schemaVia _ = schemaVia (Proxy :: Proxy [a])
+  toEncoding = toEncoding . SV.toList
+  deserialiser = SV.fromList <$> deserialiser
+
+instance (UV.Unbox a, Serialise a) => Serialise (UV.Vector a) where
+  schemaVia _ = schemaVia (Proxy :: Proxy [a])
+  toEncoding = toEncoding . UV.toList
+  deserialiser = UV.fromList <$> deserialiser
+
+-- | Extract a list or an array of values.
+extractListWith :: Deserialiser a -> Deserialiser [a]
+extractListWith (Deserialiser plan) = Deserialiser $ Plan $ \case
+  SArray (VarInt size) s -> do
+    getItem <- unPlan plan s
+    return $ evalContT $ do
+      n <- decodeVarInt
+      asks $ \bs -> [decodeAt (size * i) getItem bs | i <- [0..n - 1]]
+  SList s -> do
+    getItem <- unPlan plan s
+    return $ evalContT $ do
+      n <- decodeVarInt
+      offsets <- decodeOffsets n
+      asks $ \bs -> [decodeAt ofs getItem bs | ofs <- offsets]
+  s -> unexpectedSchema' "extractListWith ..." "[a]" s
+
+instance (Ord k, Serialise k, Serialise v) => Serialise (M.Map k v) where
+  schemaVia _ = schemaVia (Proxy :: Proxy [(k, v)])
+  toEncoding = toEncoding . M.toList
+  deserialiser = M.fromList <$> deserialiser
+
+instance (Eq k, Hashable k, Serialise k, Serialise v) => Serialise (HM.HashMap k v) where
+  schemaVia _ = schemaVia (Proxy :: Proxy [(k, v)])
+  toEncoding = toEncoding . HM.toList
+  deserialiser = HM.fromList <$> deserialiser
+
+instance (Serialise v) => Serialise (IM.IntMap v) where
+  schemaVia _ = schemaVia (Proxy :: Proxy [(Int, v)])
+  toEncoding = toEncoding . IM.toList
+  deserialiser = IM.fromList <$> deserialiser
+
+instance (Ord a, Serialise a) => Serialise (S.Set a) where
+  schemaVia _ = schemaVia (Proxy :: Proxy [a])
+  toEncoding = toEncoding . S.toList
+  deserialiser = S.fromList <$> deserialiser
+
+instance Serialise IS.IntSet where
+  schemaVia _ = schemaVia (Proxy :: Proxy [Int])
+  toEncoding = toEncoding . IS.toList
+  deserialiser = IS.fromList <$> deserialiser
+
+instance Serialise a => Serialise (Seq.Seq a) where
+  schemaVia _ = schemaVia (Proxy :: Proxy [a])
+  toEncoding = toEncoding . toList
+  deserialiser = Seq.fromList <$> deserialiser
+
+instance Serialise a => Serialise (Identity a) where
+  schemaVia _ = schemaVia (Proxy :: Proxy a)
+  toEncoding = toEncoding . runIdentity
+  deserialiser = Identity <$> deserialiser
+  constantSize _ = constantSize (Proxy :: Proxy a)
+
+-- | Extract a field of a record.
+extractField :: Serialise a => T.Text -> Deserialiser a
+extractField = extractFieldWith deserialiser
+{-# INLINE extractField #-}
+
+-- | Extract a field using the supplied 'Deserialiser'.
+extractFieldWith :: Typeable a => Deserialiser a -> T.Text -> Deserialiser a
+extractFieldWith (Deserialiser g) name = Deserialiser $ handleRecursion $ \case
+  SRecord schs -> do
+    let schs' = [(k, (i, s)) | (i, (k, s)) <- zip [0..] schs]
+    case lookup name schs' of
+      Just (i, sch) -> do
+        m <- unPlan g sch
+        return $ evalContT $ do
+          offsets <- decodeOffsets (length schs)
+          lift $ decodeAt (unsafeIndex msg offsets i) m
+      Nothing -> errorStrategy $ rep <> ": Schema not found in " <> pretty (map fst schs)
+  s -> unexpectedSchema' rep "a record" s
+  where
+    rep = "extractFieldWith ... " <> dquotes (pretty name)
+    msg = "Data.Winery.extractFieldWith ... " <> show name <> ": impossible"
+
+handleRecursion :: Typeable a => (Schema -> Strategy (Decoder a)) -> Plan (Decoder a)
+handleRecursion k = Plan $ \sch -> Strategy $ \decs -> case sch of
+  SSelf i -> return $ fmap (`fromDyn` error "Invalid recursion")
+    $ unsafeIndex "Data.Winery.handleRecursion: unbound fixpoint" decs (fromIntegral i)
+  SFix s -> mfix $ \a -> unPlan (handleRecursion k) s `unStrategy` (fmap toDyn a : decs)
+  s -> k s `unStrategy` decs
+
+instance (Serialise a, Serialise b) => Serialise (a, b) where
+  schemaVia _ ts = case (constantSize (Proxy :: Proxy a), constantSize (Proxy :: Proxy b)) of
+    (Just a, Just b) -> SProductFixed [(VarInt a, sa), (VarInt b, sb)]
+    _ -> SProduct [sa, sb]
+    where
+      sa = substSchema (Proxy :: Proxy a) ts
+      sb = substSchema (Proxy :: Proxy b) ts
+  toEncoding (a, b) = case constantSize (Proxy :: Proxy (a, b)) of
+    Nothing -> encodeMulti [toEncoding a, toEncoding b]
+    Just _ -> toEncoding a <> toEncoding b
+  deserialiser = Deserialiser $ Plan $ \case
+    SProduct [sa, sb] -> do
+      getA <- unwrapDeserialiser deserialiser sa
+      getB <- unwrapDeserialiser deserialiser sb
+      return $ evalContT $ do
+        offA <- decodeVarInt
+        asks $ \bs -> (getA bs, decodeAt offA getB bs)
+    SProductFixed [(VarInt la, sa), (_, sb)] -> do
+      getA <- unwrapDeserialiser deserialiser sa
+      getB <- unwrapDeserialiser deserialiser sb
+      return $ \bs -> (getA bs, decodeAt la getB bs)
+    s -> unexpectedSchema "Serialise (a, b)" s
+
+  constantSize _ = (+) <$> constantSize (Proxy :: Proxy a) <*> constantSize (Proxy :: Proxy b)
+
+instance (Serialise a, Serialise b, Serialise c) => Serialise (a, b, c) where
+  schemaVia _ ts = case (constantSize (Proxy :: Proxy a), constantSize (Proxy :: Proxy b), constantSize (Proxy :: Proxy c)) of
+    (Just a, Just b, Just c) -> SProductFixed [(VarInt a, sa), (VarInt b, sb), (VarInt c, sc)]
+    _ -> SProduct [sa, sb, sc]
+    where
+      sa = substSchema (Proxy :: Proxy a) ts
+      sb = substSchema (Proxy :: Proxy b) ts
+      sc = substSchema (Proxy :: Proxy c) ts
+  toEncoding (a, b, c) = case constantSize (Proxy :: Proxy (a, b, c)) of
+    Nothing -> encodeMulti [toEncoding a, toEncoding b, toEncoding c]
+    Just _ -> toEncoding a <> toEncoding b <> toEncoding c
+  deserialiser = Deserialiser $ Plan $ \case
+    SProduct [sa, sb, sc] -> do
+      getA <- unwrapDeserialiser deserialiser sa
+      getB <- unwrapDeserialiser deserialiser sb
+      getC <- unwrapDeserialiser deserialiser sc
+      return $ evalContT $ do
+        offA <- decodeVarInt
+        offB <- decodeVarInt
+        asks $ \bs -> (getA bs, decodeAt offA getB bs, decodeAt (offA + offB) getC bs)
+    SProductFixed [(VarInt la, sa), (VarInt lb, sb), (_, sc)] -> do
+      getA <- unwrapDeserialiser deserialiser sa
+      getB <- unwrapDeserialiser deserialiser sb
+      getC <- unwrapDeserialiser deserialiser sc
+      return $ \bs -> (getA bs, decodeAt la getB bs, decodeAt (la + lb) getC bs)
+    s -> unexpectedSchema "Serialise (a, b, c)" s
+
+  constantSize _ = fmap sum $ sequence [constantSize (Proxy :: Proxy a), constantSize (Proxy :: Proxy b), constantSize (Proxy :: Proxy c)]
+
+instance (Serialise a, Serialise b, Serialise c, Serialise d) => Serialise (a, b, c, d) where
+  schemaVia _ ts = case (constantSize (Proxy :: Proxy a), constantSize (Proxy :: Proxy b), constantSize (Proxy :: Proxy c), constantSize (Proxy :: Proxy d)) of
+    (Just a, Just b, Just c, Just d) -> SProductFixed [(VarInt a, sa), (VarInt b, sb), (VarInt c, sc), (VarInt d, sd)]
+    _ -> SProduct [sa, sb, sc, sd]
+    where
+      sa = substSchema (Proxy :: Proxy a) ts
+      sb = substSchema (Proxy :: Proxy b) ts
+      sc = substSchema (Proxy :: Proxy c) ts
+      sd = substSchema (Proxy :: Proxy d) ts
+  toEncoding (a, b, c, d) = case constantSize (Proxy :: Proxy (a, b, c)) of
+    Nothing -> encodeMulti [toEncoding a, toEncoding b, toEncoding c, toEncoding d]
+    Just _ -> toEncoding a <> toEncoding b <> toEncoding c <> toEncoding d
+  deserialiser = Deserialiser $ Plan $ \case
+    SProduct [sa, sb, sc, sd] -> do
+      getA <- unwrapDeserialiser deserialiser sa
+      getB <- unwrapDeserialiser deserialiser sb
+      getC <- unwrapDeserialiser deserialiser sc
+      getD <- unwrapDeserialiser deserialiser sd
+      return $ evalContT $ do
+        offA <- decodeVarInt
+        offB <- decodeVarInt
+        offC <- decodeVarInt
+        asks $ \bs -> (getA bs, decodeAt offA getB bs, decodeAt (offA + offB) getC bs, decodeAt (offA + offB + offC) getD bs)
+    SProductFixed [(VarInt la, sa), (VarInt lb, sb), (VarInt lc, sc), (_, sd)] -> do
+      getA <- unwrapDeserialiser deserialiser sa
+      getB <- unwrapDeserialiser deserialiser sb
+      getC <- unwrapDeserialiser deserialiser sc
+      getD <- unwrapDeserialiser deserialiser sd
+      return $ \bs -> (getA bs, decodeAt la getB bs, decodeAt (la + lb) getC bs, decodeAt (la + lb + lc) getD bs)
+    s -> unexpectedSchema "Serialise (a, b, c, d)" s
+
+  constantSize _ = fmap sum $ sequence [constantSize (Proxy :: Proxy a), constantSize (Proxy :: Proxy b), constantSize (Proxy :: Proxy c), constantSize (Proxy :: Proxy d)]
+
+instance (Serialise a, Serialise b) => Serialise (Either a b) where
+  schemaVia _ ts = SVariant [("Left", [substSchema (Proxy :: Proxy a) ts])
+    , ("Right", [substSchema (Proxy :: Proxy b) ts])]
+  toEncoding (Left a) = (1, BB.word8 0) <> toEncoding a
+  toEncoding (Right b) = (1, BB.word8 1) <> toEncoding b
+  deserialiser = Deserialiser $ Plan $ \case
+    SVariant [(_, [sa]), (_, [sb])] -> do
+      getA <- unwrapDeserialiser deserialiser sa
+      getB <- unwrapDeserialiser deserialiser sb
+      return $ evalContT $ do
+        t <- decodeVarInt
+        case t :: Word8 of
+          0 -> Left <$> lift getA
+          _ -> Right <$> lift getB
+    s -> unexpectedSchema "Either (a, b)" s
+  constantSize _ = fmap (1+) $ max
+    <$> constantSize (Proxy :: Proxy a)
+    <*> constantSize (Proxy :: Proxy b)
+
+-- | Tries to extract a specific constructor of a variant. Useful for
+-- implementing backward-compatible deserialisers.
+extractConstructorWith :: Typeable a => Deserialiser a -> T.Text -> Deserialiser (Maybe a)
+extractConstructorWith d name = Deserialiser $ handleRecursion $ \case
+  SVariant schs0 -> Strategy $ \decs -> do
+    (j, dec) <- case [(i :: Int, ss) | (i, (k, ss)) <- zip [0..] schs0, name == k] of
+      [(i, [s])] -> fmap ((,) i) $ unwrapDeserialiser d s `unStrategy` decs
+      [(i, ss)] -> fmap ((,) i) $ unwrapDeserialiser d (SProduct ss) `unStrategy` decs
+      _ -> Left $ rep <> ": Schema not found in " <> pretty (map fst schs0)
+
+    return $ evalContT $ do
+      i <- decodeVarInt
+      if i == j
+        then Just <$> lift dec
+        else pure Nothing
+  s -> unexpectedSchema' rep "a variant" s
+  where
+    rep = "extractConstructorWith ... " <> dquotes (pretty name)
+
+extractConstructor :: (Serialise a) => T.Text -> Deserialiser (Maybe a)
+extractConstructor = extractConstructorWith deserialiser
+{-# INLINE extractConstructor #-}
+
+data RecordDecoder i x = Done x | forall a. More !i !(Maybe a) !(Plan (Decoder a)) (RecordDecoder i (Decoder a -> x))
+
+deriving instance Functor (RecordDecoder i)
+
+instance Applicative (RecordDecoder i) where
+  pure = Done
+  Done f <*> a = fmap f a
+  More i p d k <*> c = More i p d (flip <$> k <*> c)
+
+-- | Generic implementation of 'schemaVia' for a record.
+gschemaViaRecord :: forall proxy a. (GSerialiseRecord (Rep a), Generic a, Typeable a) => proxy a -> [TypeRep] -> Schema
+gschemaViaRecord p ts = SFix $ SRecord $ recordSchema (Proxy :: Proxy (Rep a)) (typeRep p : ts)
+
+-- | Generic implementation of 'toEncoding' for a record.
+gtoEncodingRecord :: (GSerialiseRecord (Rep a), Generic a) => a -> Encoding
+gtoEncodingRecord = encodeMulti . recordEncoder . from
+{-# INLINE gtoEncodingRecord #-}
+
+-- | Generic implementation of 'deserialiser' for a record.
+gdeserialiserRecord :: forall a. (GSerialiseRecord (Rep a), Generic a, Typeable a)
+  => Maybe a -- ^ default value (optional)
+  -> Deserialiser a
+gdeserialiserRecord def = Deserialiser $ handleRecursion $ \case
+  SRecord schs -> Strategy $ \decs -> do
+    let schs' = [(k, (i, s)) | (i, (k, s)) <- zip [0..] schs]
+    let go :: RecordDecoder T.Text x -> Either StrategyError ([Int] -> x)
+        go (Done a) = Right $ const a
+        go (More name def' p k) = case lookup name schs' of
+          Nothing -> case def' of
+            Just d -> go k >>= \r -> return $ \offsets -> r offsets (pure d)
+            Nothing -> Left $ rep <> ": Default value not found for " <> pretty name
+          Just (i, sch) -> do
+            getItem <- p `unPlan` sch `unStrategy` decs
+            r <- go k
+            return $ \offsets -> r offsets
+              $ decodeAt (unsafeIndex "Data.Winery.gdeserialiserRecord: impossible" offsets i) getItem
+    m <- go $ recordDecoder $ from <$> def
+    return $ evalContT $ do
+      offsets <- decodeOffsets (length schs)
+      asks $ \bs -> to $ m offsets bs
+  s -> unexpectedSchema' rep "a record" s
+  where
+    rep = "gdeserialiserRecord :: Deserialiser "
+      <> viaShow (typeRep (Proxy :: Proxy a))
+
+class GSerialiseRecord f where
+  recordSchema :: proxy f -> [TypeRep] -> [(T.Text, Schema)]
+  recordEncoder :: f x -> [Encoding]
+  recordDecoder :: Maybe (f x) -> RecordDecoder T.Text (Decoder (f x))
+
+instance (GSerialiseRecord f, GSerialiseRecord g) => GSerialiseRecord (f :*: g) where
+  recordSchema _ ts = recordSchema (Proxy :: Proxy f) ts
+    ++ recordSchema (Proxy :: Proxy g) ts
+  recordEncoder (f :*: g) = recordEncoder f ++ recordEncoder g
+  recordDecoder def = (\f g -> (:*:) <$> f <*> g)
+    <$> recordDecoder ((\(x :*: _) -> x) <$> def)
+    <*> recordDecoder ((\(_ :*: x) -> x) <$> def)
+
+instance (Serialise a, Selector c) => GSerialiseRecord (S1 c (K1 i a)) where
+  recordSchema _ ts = [(T.pack $ selName (M1 undefined :: M1 i c (K1 i a) x), substSchema (Proxy :: Proxy a) ts)]
+  recordEncoder (M1 (K1 a)) = [toEncoding a]
+  recordDecoder def = More (T.pack $ selName (M1 undefined :: M1 i c (K1 i a) x)) (unK1 . unM1 <$> def) (getDeserialiser deserialiser)
+    $ Done $ fmap $ M1 . K1
+
+instance (GSerialiseRecord f) => GSerialiseRecord (C1 c f) where
+  recordSchema _ = recordSchema (Proxy :: Proxy f)
+  recordEncoder (M1 a) = recordEncoder a
+  recordDecoder def = fmap M1 <$> recordDecoder (unM1 <$> def)
+
+instance (GSerialiseRecord f) => GSerialiseRecord (D1 c f) where
+  recordSchema _ = recordSchema (Proxy :: Proxy f)
+  recordEncoder (M1 a) = recordEncoder a
+  recordDecoder def = fmap M1 <$> recordDecoder (unM1 <$> def)
+
+class GSerialiseProduct f where
+  productSchema :: proxy f -> [TypeRep] -> [Schema]
+  productEncoder :: f x -> [Encoding]
+  productDecoder :: RecordDecoder () (Decoder (f x))
+
+instance GSerialiseProduct U1 where
+  productSchema _ _ = []
+  productEncoder _ = []
+  productDecoder = Done (pure U1)
+
+instance (Serialise a) => GSerialiseProduct (K1 i a) where
+  productSchema _ ts = [substSchema (Proxy :: Proxy a) ts]
+  productEncoder (K1 a) = [toEncoding a]
+  productDecoder = More () Nothing (getDeserialiser deserialiser) $ Done $ fmap K1
+
+instance GSerialiseProduct f => GSerialiseProduct (M1 i c f) where
+  productSchema _ ts = productSchema (Proxy :: Proxy f) ts
+  productEncoder (M1 a) = productEncoder a
+  productDecoder = fmap M1 <$> productDecoder
+
+instance (GSerialiseProduct f, GSerialiseProduct g) => GSerialiseProduct (f :*: g) where
+  productSchema _ ts = productSchema (Proxy :: Proxy f) ts ++ productSchema (Proxy :: Proxy g) ts
+  productEncoder (f :*: g) = productEncoder f ++ productEncoder g
+  productDecoder = liftA2 (:*:) <$> productDecoder <*> productDecoder
+
+deserialiserProduct' :: GSerialiseProduct f => [Schema] -> Strategy (Decoder (f x))
+deserialiserProduct' schs0 = Strategy $ \recs -> do
+  let go :: Int -> [Schema] -> RecordDecoder () x -> Either StrategyError ([Int] -> x)
+      go _ _ (Done a) = Right $ const a
+      go _ [] _ = Left "deserialiserProduct': Mismatching number of fields"
+      go i (sch : schs) (More () _ p k) = do
+        getItem <- unPlan p sch `unStrategy` recs
+        r <- go (i + 1) schs k
+        return $ \offsets -> r offsets $ decodeAt (unsafeIndex "Data.Winery.gdeserialiserProduct: impossible" offsets i) getItem
+  m <- go 0 schs0 productDecoder
+  return $ evalContT $ do
+    offsets <- decodeOffsets (length schs0)
+    asks $ \bs -> m offsets bs
+
+-- | Generic implementation of 'schemaVia' for an ADT.
+gschemaViaVariant :: forall proxy a. (GSerialiseVariant (Rep a), Typeable a, Generic a) => proxy a -> [TypeRep] -> Schema
+gschemaViaVariant p ts = SFix $ SVariant $ variantSchema (Proxy :: Proxy (Rep a)) (typeRep p : ts)
+
+-- | Generic implementation of 'toEncoding' for an ADT.
+gtoEncodingVariant :: (GSerialiseVariant (Rep a), Generic a) => a -> Encoding
+gtoEncodingVariant = variantEncoder 0 . from
+{-# INLINE gtoEncodingVariant #-}
+
+-- | Generic implementation of 'deserialiser' for an ADT.
+gdeserialiserVariant :: forall a. (GSerialiseVariant (Rep a), Generic a, Typeable a)
+  => Deserialiser a
+gdeserialiserVariant = Deserialiser $ handleRecursion $ \case
+  SVariant schs0 -> Strategy $ \decs -> do
+    ds' <- sequence
+      [ case lookup name variantDecoder of
+          Nothing -> Left $ rep <> ": Schema not found for " <> pretty name
+          Just f -> f sch `unStrategy` decs
+      | (name, sch) <- schs0]
+    return $ evalContT $ do
+      i <- decodeVarInt
+      lift $ fmap to $ unsafeIndex "Data.Winery.gdeserialiserVariant" ds' i
+  s -> unexpectedSchema' rep "a variant" s
+  where
+    rep = "gdeserialiserVariant :: Deserialiser "
+      <> viaShow (typeRep (Proxy :: Proxy a))
+
+class GSerialiseVariant f where
+  variantCount :: proxy f -> Int
+  variantSchema :: proxy f -> [TypeRep] -> [(T.Text, [Schema])]
+  variantEncoder :: Int -> f x -> Encoding
+  variantDecoder :: [(T.Text, [Schema] -> Strategy (Decoder (f x)))]
+
+instance (GSerialiseVariant f, GSerialiseVariant g) => GSerialiseVariant (f :+: g) where
+  variantCount _ = variantCount (Proxy :: Proxy f) + variantCount (Proxy :: Proxy g)
+  variantSchema _ ts = variantSchema (Proxy :: Proxy f) ts ++ variantSchema (Proxy :: Proxy g) ts
+  variantEncoder i (L1 f) = variantEncoder i f
+  variantEncoder i (R1 g) = variantEncoder (i + variantCount (Proxy :: Proxy f)) g
+  variantDecoder = fmap (fmap (fmap (fmap (fmap L1)))) variantDecoder
+    ++ fmap (fmap (fmap (fmap (fmap R1)))) variantDecoder
+
+instance (GSerialiseProduct f, Constructor c) => GSerialiseVariant (C1 c f) where
+  variantCount _ = 1
+  variantSchema _ ts = [(T.pack $ conName (M1 undefined :: M1 i c f x), productSchema (Proxy :: Proxy f) ts)]
+  variantEncoder i (M1 a) = encodeVarInt i <> encodeMulti (productEncoder a)
+  variantDecoder = [(T.pack $ conName (M1 undefined :: M1 i c f x)
+    , fmap (fmap M1) . deserialiserProduct') ]
+
+instance (GSerialiseVariant f) => GSerialiseVariant (S1 c f) where
+  variantCount _ = variantCount (Proxy :: Proxy f)
+  variantSchema _ ts = variantSchema (Proxy :: Proxy f) ts
+  variantEncoder i (M1 a) = variantEncoder i a
+  variantDecoder = fmap (fmap (fmap (fmap M1))) <$> variantDecoder
+
+instance (GSerialiseVariant f) => GSerialiseVariant (D1 c f) where
+  variantCount _ = variantCount (Proxy :: Proxy f)
+  variantSchema _ ts = variantSchema (Proxy :: Proxy f) ts
+  variantEncoder i (M1 a) = variantEncoder i a
+  variantDecoder = fmap (fmap (fmap (fmap M1))) <$> variantDecoder
diff --git a/src/Data/Winery/Internal.hs b/src/Data/Winery/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Winery/Internal.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Data.Winery.Internal
+  ( Encoding
+  , encodeMulti
+  , encodeVarInt
+  , Decoder
+  , decodeAt
+  , decodeVarInt
+  , decodeOffsets
+  , getWord8
+  , getBytes
+  , word16be
+  , word32be
+  , word64be
+  , unsafeIndex
+  , Strategy(..)
+  , StrategyError
+  , errorStrategy
+  )where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.Trans.Cont
+import Data.ByteString.Builder
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Unsafe as B
+import qualified Data.ByteString.Builder as BB
+import Data.Bits
+import Data.Dynamic
+import Data.Monoid
+import Data.Text.Prettyprint.Doc (Doc)
+import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)
+import Data.Word
+
+type Encoding = (Sum Int, Builder)
+
+type Decoder = (->) B.ByteString
+
+decodeAt :: Int -> Decoder a -> Decoder a
+decodeAt i m bs = m $ B.drop i bs
+
+encodeVarInt :: (Integral a, Bits a) => a -> Encoding
+encodeVarInt n
+  | n < 0x80 = (1, BB.word8 $ fromIntegral n)
+  | otherwise = let (s, b) = encodeVarInt (shiftR n 7)
+    in (1 + s, BB.word8 (setBit (fromIntegral n) 7) `mappend` b)
+
+getWord8 :: ContT r Decoder Word8
+getWord8 = ContT $ \k bs -> case B.uncons bs of
+  Nothing -> k 0 bs
+  Just (x, bs') -> k x bs'
+
+getBytes :: Decoder B.ByteString
+getBytes = runContT decodeVarInt B.take
+
+decodeVarInt :: (Num a, Bits a) => ContT r Decoder a
+decodeVarInt = getWord8 >>= \case
+  n | testBit n 7 -> do
+      m <- decodeVarInt
+      return $! shiftL m 7 .|. clearBit (fromIntegral n) 7
+    | otherwise -> return $ fromIntegral n
+
+word16be :: B.ByteString -> Word16
+word16be = \s ->
+  (fromIntegral (s `B.unsafeIndex` 0) `unsafeShiftL` 8) .|.
+  (fromIntegral (s `B.unsafeIndex` 1))
+
+word32be :: B.ByteString -> Word32
+word32be = \s ->
+  (fromIntegral (s `B.unsafeIndex` 0) `unsafeShiftL` 24) .|.
+  (fromIntegral (s `B.unsafeIndex` 1) `unsafeShiftL` 16) .|.
+  (fromIntegral (s `B.unsafeIndex` 2) `unsafeShiftL`  8) .|.
+  (fromIntegral (s `B.unsafeIndex` 3) )
+
+word64be :: B.ByteString -> Word64
+word64be = \s ->
+  (fromIntegral (s `B.unsafeIndex` 0) `unsafeShiftL` 56) .|.
+  (fromIntegral (s `B.unsafeIndex` 1) `unsafeShiftL` 48) .|.
+  (fromIntegral (s `B.unsafeIndex` 2) `unsafeShiftL` 40) .|.
+  (fromIntegral (s `B.unsafeIndex` 3) `unsafeShiftL` 32) .|.
+  (fromIntegral (s `B.unsafeIndex` 4) `unsafeShiftL` 24) .|.
+  (fromIntegral (s `B.unsafeIndex` 5) `unsafeShiftL` 16) .|.
+  (fromIntegral (s `B.unsafeIndex` 6) `unsafeShiftL`  8) .|.
+  (fromIntegral (s `B.unsafeIndex` 7) )
+
+encodeMulti :: [Encoding] -> Encoding
+encodeMulti ls = foldMap encodeVarInt offsets <> foldMap id ls where
+  offsets = take (length ls - 1) $ map (getSum . fst) ls
+
+decodeOffsets :: Int -> ContT r Decoder [Int]
+decodeOffsets 0 = pure []
+decodeOffsets n = scanl (+) 0 <$> replicateM (n - 1) decodeVarInt
+
+unsafeIndex :: String -> [a] -> Int -> a
+unsafeIndex err xs i = (xs ++ repeat (error err)) !! i
+
+type StrategyError = Doc AnsiStyle
+
+newtype Strategy a = Strategy { unStrategy :: [Decoder Dynamic] -> Either StrategyError a }
+  deriving Functor
+
+instance Applicative Strategy where
+  pure = return
+  (<*>) = ap
+
+instance Monad Strategy where
+  return = Strategy . const . Right
+  m >>= k = Strategy $ \decs -> case unStrategy m decs of
+    Right a -> unStrategy (k a) decs
+    Left e -> Left e
+
+instance Alternative Strategy where
+  empty = Strategy $ const $ Left "empty"
+  Strategy a <|> Strategy b = Strategy $ \decs -> case a decs of
+    Left _ -> b decs
+    Right x -> Right x
+
+instance MonadFix Strategy where
+  mfix f = Strategy $ \r -> mfix $ \a -> unStrategy (f a) r
+  {-# INLINE mfix #-}
+
+errorStrategy :: Doc AnsiStyle -> Strategy a
+errorStrategy = Strategy . const . Left
diff --git a/src/Data/Winery/Term.hs b/src/Data/Winery/Term.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Winery/Term.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE OverloadedStrings, LambdaCase #-}
+module Data.Winery.Term where
+
+import Control.Monad.Trans
+import Control.Monad.Trans.Cont
+import Control.Monad.Reader
+import qualified Data.ByteString as B
+import Data.Int
+import qualified Data.Text as T
+import Data.Text.Prettyprint.Doc
+import Data.Text.Prettyprint.Doc.Render.Terminal
+import Data.Winery
+import Data.Winery.Internal
+import Data.Word
+
+-- | Common representation for any winery data.
+-- Handy for prettyprinting winery-serialised data.
+data Term = TUnit
+  | TBool !Bool
+  | TChar !Char
+  | TWord8 !Word8
+  | TWord16 !Word16
+  | TWord32 !Word32
+  | TWord64 !Word64
+  | TInt8 !Int8
+  | TInt16 !Int16
+  | TInt32 !Int32
+  | TInt64 !Int64
+  | TInteger !Integer
+  | TFloat !Float
+  | TDouble !Double
+  | TBytes !B.ByteString
+  | TText !T.Text
+  | TList [Term]
+  | TProduct [Term]
+  | TRecord [(T.Text, Term)]
+  | TVariant !T.Text [Term]
+  deriving Show
+
+-- | Deserialiser for a 'Term'.
+decodeTerm :: Deserialiser Term
+decodeTerm = go [] where
+  go points = Deserialiser $ Plan $ \s -> case s of
+    SSchema ver -> Strategy (const $ bootstrapSchema ver) >>= unwrapDeserialiser (go points)
+    SUnit -> pure (pure TUnit)
+    SBool -> p s TBool
+    Data.Winery.SChar -> p s TChar
+    SWord8 -> p s TWord8
+    SWord16 -> p s TWord16
+    SWord32 -> p s TWord32
+    SWord64 -> p s TWord64
+    SInt8 -> p s TInt8
+    SInt16 -> p s TInt16
+    SInt32 -> p s TInt32
+    SInt64 -> p s TInt64
+    SInteger -> p s TInteger
+    SFloat -> p s TFloat
+    SDouble -> p s TDouble
+    SBytes -> p s TBytes
+    Data.Winery.SText -> p s TText
+    SArray siz sch -> fmap TList <$> extractListWith (go points) `unwrapDeserialiser` SArray siz sch
+    SList sch -> fmap TList <$> extractListWith (go points) `unwrapDeserialiser` SList sch
+    SProduct schs -> do
+      decoders <- traverse (unwrapDeserialiser $ go points) schs
+      return $ evalContT $ do
+        offsets <- decodeOffsets (length decoders)
+        asks $ \bs -> TProduct [decodeAt ofs dec bs | (dec, ofs) <- zip decoders offsets]
+    SProductFixed schs -> do
+      decoders <- traverse (\(VarInt n, sch) -> (,) n <$> unwrapDeserialiser (go points) sch) schs
+      let f bs ((n, dec) : decs) = dec bs : f (B.drop n bs) decs
+          f _ [] = []
+      return $ \bs -> TProduct $ f bs decoders
+    SRecord schs -> do
+      decoders <- traverse (\(name, sch) -> (,) name <$> unwrapDeserialiser (go points) sch) schs
+      return $ evalContT $ do
+        offsets <- decodeOffsets (length decoders)
+        asks $ \bs -> TRecord [(name, decodeAt ofs dec bs) | ((name, dec), ofs) <- zip decoders offsets]
+    SVariant schs -> do
+      decoders <- traverse (\(name, sch) -> (,) name <$> traverse (unwrapDeserialiser (go points)) sch) schs
+      return $ evalContT $ do
+        tag <- decodeVarInt
+        let (name, decs) = unsafeIndex ("decodeTerm/SVariant") decoders tag
+        offsets <- decodeOffsets (length decs)
+        asks $ \bs -> TVariant name [decodeAt ofs dec bs | (dec, ofs) <- zip decs offsets]
+    SSelf i -> return $ unsafeIndex "decodeTerm/SSelf" points $ fromIntegral i
+    SFix s' -> mfix $ \a -> go (a : points) `unwrapDeserialiser` s'
+
+  p s f = fmap f <$> unwrapDeserialiser deserialiser s
+
+-- | Deserialise a 'serialise'd 'B.Bytestring'.
+deserialiseTerm :: B.ByteString -> Either (Doc AnsiStyle) (Schema, Term)
+deserialiseTerm bs_ = case B.uncons bs_ of
+  Just (ver, bs) -> do
+    getSchema <- getDecoder $ SSchema ver
+    ($bs) $ evalContT $ do
+      offB <- decodeVarInt
+      sch <- lift getSchema
+      body <- asks $ \bs' -> ($ B.drop offB bs') <$> getDecoderBy decodeTerm sch
+      return ((,) sch <$> body)
+  Nothing -> Left "Unexpected empty string"
+
+instance Pretty Term where
+  pretty TUnit = "()"
+  pretty (TWord8 i) = pretty i
+  pretty (TWord16 i) = pretty i
+  pretty (TWord32 i) = pretty i
+  pretty (TWord64 i) = pretty i
+  pretty (TInt8 i) = pretty i
+  pretty (TInt16 i) = pretty i
+  pretty (TInt32 i) = pretty i
+  pretty (TInt64 i) = pretty i
+  pretty (TInteger i) = pretty i
+  pretty (TBytes s) = pretty $ show s
+  pretty (TText s) = pretty s
+  pretty (TList xs) = list $ map pretty xs
+  pretty (TBool x) = pretty x
+  pretty (TChar x) = pretty x
+  pretty (TFloat x) = pretty x
+  pretty (TDouble x) = pretty x
+  pretty (TProduct xs) = tupled $ map pretty xs
+  pretty (TRecord xs) = align $ encloseSep "{ " " }" ", " [group $ nest 2 $ vsep [pretty k <+> "=", pretty v] | (k, v) <- xs]
+  pretty (TVariant tag []) = pretty tag
+  pretty (TVariant tag xs) = group $ nest 2 $ vsep $ pretty tag : map pretty xs
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE DeriveGeneric, OverloadedStrings, OverloadedLabels, DataKinds, TypeOperators, GeneralizedNewtypeDeriving #-}
+import Control.Monad.Fix
+import Data.ByteString (ByteString)
+import Data.Winery
+import Data.Winery.Term
+import GHC.Generics
+
+data TestRec = TestRec
+    { foo :: Maybe Int
+    , bar :: [ByteString]
+    , nodes :: [TestRec]
+    } deriving (Show, Generic)
+
+instance Serialise TestRec where
+  schemaVia = gschemaViaRecord
+  toEncoding = gtoEncodingRecord
+  deserialiser = TestRec
+    <$> extractField "foo"
+    <*> extractField "bar"
+    <*> extractFieldWith (extractListWith deserialiser) "nodes"
+
+defTest :: TestRec
+defTest = TestRec Nothing ["hello"] [TestRec (Just 42) ["world"] []]
+
+main :: IO ()
+main = return ()
+
+data TestVar = VFoo | VBar !Int | VBaz !Bool !Bool deriving (Show, Generic)
+
+instance Serialise TestVar
+
+newtype UserId = UserId Int deriving Serialise
diff --git a/winery.cabal b/winery.cabal
new file mode 100644
--- /dev/null
+++ b/winery.cabal
@@ -0,0 +1,94 @@
+-- This file has been generated from package.yaml by hpack version 0.28.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: bfdedbe9822eecf89f3ba7e7ecbf8802c6078d4f65ce427c1f942dbc695ac72b
+
+name:           winery
+version:        0
+synopsis:       Sustainable serialisation library
+description:    Please see the README on Github at <https://github.com/fumieval/winery#readme>
+category:       Data
+homepage:       https://github.com/fumieval/winery#readme
+bug-reports:    https://github.com/fumieval/winery/issues
+author:         Fumiaki Kinoshita
+maintainer:     fumiexcel@gmail.com
+copyright:      Copyright (c) 2017 Fumiaki Kinoshita
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+cabal-version:  >= 1.10
+extra-source-files:
+    ChangeLog.md
+    README.md
+
+source-repository head
+  type: git
+  location: https://github.com/fumieval/winery
+
+library
+  hs-source-dirs:
+      src
+  ghc-options: -Wall
+  build-depends:
+      base >=4.7 && <5
+    , bytestring
+    , containers
+    , hashable
+    , mtl
+    , prettyprinter
+    , prettyprinter-ansi-terminal
+    , text
+    , transformers
+    , unordered-containers
+    , vector
+  exposed-modules:
+      Data.Winery
+      Data.Winery.Term
+      Data.Winery.Internal
+  other-modules:
+      Paths_winery
+  default-language: Haskell2010
+
+executable winery
+  main-is: Main.hs
+  other-modules:
+      Paths_winery
+  hs-source-dirs:
+      app
+  build-depends:
+      base >=4.7 && <5
+    , bytestring
+    , containers
+    , hashable
+    , mtl
+    , prettyprinter
+    , prettyprinter-ansi-terminal
+    , text
+    , transformers
+    , unordered-containers
+    , vector
+    , winery
+  default-language: Haskell2010
+
+test-suite spec
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  hs-source-dirs:
+      test
+  build-depends:
+      base >=4.7 && <5
+    , bytestring
+    , containers
+    , hashable
+    , mtl
+    , prettyprinter
+    , prettyprinter-ansi-terminal
+    , text
+    , transformers
+    , unordered-containers
+    , vector
+    , winery
+  other-modules:
+      Paths_winery
+  default-language: Haskell2010