diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,22 @@
+Copyright (c) 2020 Nikita Volkov
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
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/library/THLego/Helpers.hs b/library/THLego/Helpers.hs
new file mode 100644
--- /dev/null
+++ b/library/THLego/Helpers.hs
@@ -0,0 +1,131 @@
+module THLego.Helpers
+where
+
+import THLego.Prelude
+import Language.Haskell.TH
+import qualified TemplateHaskell.Compat.V0208 as Compat
+import qualified Data.Text as Text
+
+
+-- * Decs
+-------------------------
+
+typeSynonymDec :: Name -> Type -> Dec
+typeSynonymDec a b =
+  TySynD a [] b
+
+recordNewtypeDec :: Name -> Name -> Type -> Dec
+recordNewtypeDec _name _accessorName _type =
+  NewtypeD [] _name [] Nothing _con []
+  where
+    _con =
+      RecC _name [(_accessorName, noBang, _type)]
+
+normalNewtypeDec :: Name -> Type -> Dec
+normalNewtypeDec _name _type =
+  NewtypeD [] _name [] Nothing _con []
+  where
+    _con =
+      NormalC _name [(noBang, _type)]
+
+recordAdtDec :: Name -> [(Name, Type)] -> Dec
+recordAdtDec typeName fields =
+  DataD [] typeName [] Nothing [con] []
+  where
+    con =
+      RecC typeName (fmap (\ (fieldName, fieldType) -> (fieldName, fieldBang, fieldType)) fields)
+
+productAdtDec :: Name -> [Type] -> Dec
+productAdtDec typeName memberTypes =
+  DataD [] typeName [] Nothing [con] []
+  where
+    con =
+      NormalC typeName (fmap ((fieldBang,)) memberTypes)
+
+sumAdtDec :: Name -> [(Name, [Type])] -> Dec
+sumAdtDec a b =
+  DataD [] a [] Nothing (fmap (uncurry sumCon) b) []
+
+sumCon :: Name -> [Type] -> Con
+sumCon a b =
+  NormalC a (fmap (fieldBang,) b)
+
+enumDec :: Name -> [Name] -> Dec
+enumDec a b =
+  DataD [] a [] Nothing (fmap (\ c -> NormalC c []) b) []
+
+
+-- *
+-------------------------
+
+textName :: Text -> Name
+textName =
+  mkName . Text.unpack
+
+textTyLit :: Text -> TyLit
+textTyLit =
+  StrTyLit . Text.unpack
+
+noBang :: Bang
+noBang =
+  Bang NoSourceUnpackedness NoSourceStrictness
+
+fieldBang :: Bang
+fieldBang =
+  Bang NoSourceUnpackedness SourceStrict
+
+multiAppT :: Type -> [Type] -> Type
+multiAppT base args =
+  foldl' AppT base args
+
+multiAppE :: Exp -> [Exp] -> Exp
+multiAppE base args =
+  foldl' AppE base args
+
+arrowChainT :: [Type] -> Type -> Type
+arrowChainT params result =
+  foldr (\ a b -> AppT (AppT ArrowT a) b) result params
+
+appliedTupleT :: [Type] -> Type
+appliedTupleT a =
+  foldl' AppT (TupleT (length a)) a
+
+appliedTupleOrSingletonT :: [Type] -> Type
+appliedTupleOrSingletonT =
+  \ case
+    [a] -> a
+    a -> appliedTupleT a
+
+appliedTupleE :: [Exp] -> Exp
+appliedTupleE =
+  Compat.tupE
+
+appliedTupleOrSingletonE :: [Exp] -> Exp
+appliedTupleOrSingletonE =
+  \ case
+    [a] -> a
+    a -> appliedTupleE a
+
+indexName :: Int -> Name
+indexName =
+  mkName . showChar '_' . show
+
+enumNames :: Int -> [Name]
+enumNames =
+  fmap indexName . enumFromTo 0 . pred
+
+aName :: Name
+aName =
+  mkName "a"
+
+bName :: Name
+bName =
+  mkName "b"
+
+cName :: Name
+cName =
+  mkName "c"
+
+eqConstraintT :: Name -> Type -> Type
+eqConstraintT name =
+  AppT (AppT EqualityT (VarT name))
diff --git a/library/THLego/Instances.hs b/library/THLego/Instances.hs
new file mode 100644
--- /dev/null
+++ b/library/THLego/Instances.hs
@@ -0,0 +1,177 @@
+module THLego.Instances
+where
+
+import THLego.Prelude
+import THLego.Helpers
+import Language.Haskell.TH
+import qualified TemplateHaskell.Compat.V0208 as Compat
+import qualified Data.Text as Text
+import qualified THLego.Lambdas as Lambdas
+
+
+-- * IsLabel
+-------------------------
+
+isLabel :: TyLit -> Type -> Exp -> Dec
+isLabel label repType fromLabelExp =
+  InstanceD Nothing [] headType [fromLabelDec]
+  where
+    headType =
+      multiAppT (ConT ''IsLabel) [LitT label, repType]
+    fromLabelDec =
+      FunD 'fromLabel [Clause [] body []]
+      where
+        body =
+          NormalB fromLabelExp
+
+-- ** Constructor
+-------------------------
+
+newtypeConstructorIsLabel :: TyLit -> Type -> Name -> Type -> Dec
+newtypeConstructorIsLabel label ownerType conName memberType =
+  isLabel label repType fromLabelExp
+  where
+    repType =
+      arrowChainT [memberType] ownerType
+    fromLabelExp =
+      ConE conName
+
+sumConstructorIsLabel :: TyLit -> Type -> Name -> [Type] -> Dec
+sumConstructorIsLabel label ownerType conName memberTypes =
+  isLabel label repType fromLabelExp
+  where
+    repType =
+      arrowChainT memberTypes ownerType
+    fromLabelExp =
+      ConE conName
+
+enumConstructorIsLabel :: TyLit -> Type -> Name -> Dec
+enumConstructorIsLabel label ownerType conName =
+  isLabel label ownerType fromLabelExp
+  where
+    fromLabelExp =
+      ConE conName
+
+{-|
+'IsLabel' instance which converts tuple to ADT.
+-}
+tupleAdtConstructorIsLabel :: TyLit -> Type -> Name -> [Type] -> Dec
+tupleAdtConstructorIsLabel label ownerType conName memberTypes =
+  isLabel label repType fromLabelExp
+  where
+    repType =
+      arrowChainT [appliedTupleT memberTypes] ownerType
+    fromLabelExp =
+      Lambdas.tupleToProduct conName (length memberTypes)
+
+-- ** Accessor
+-------------------------
+
+productAccessorIsLabel :: TyLit -> Type -> Type -> Name -> Int -> Int -> Dec
+productAccessorIsLabel label ownerType projectionType conName numMembers offset =
+  isLabel label repType fromLabelExp
+  where
+    repType =
+      multiAppT ArrowT [ownerType, projectionType]
+    fromLabelExp =
+      Lambdas.productGetter conName numMembers offset
+
+sumAccessorIsLabel :: TyLit -> Type -> Name -> [Type] -> Dec
+sumAccessorIsLabel label ownerType conName memberTypes =
+  isLabel label repType fromLabelExp
+  where
+    repType =
+      multiAppT ArrowT [ownerType, projectionType]
+      where
+        projectionType =
+          AppT (ConT ''Maybe) (appliedTupleT memberTypes)
+    fromLabelExp =
+      Lambdas.adtConstructorNarrower conName (length memberTypes)
+
+enumAccessorIsLabel :: TyLit -> Type -> Name -> Dec
+enumAccessorIsLabel label ownerType conName =
+  isLabel label repType fromLabelExp
+  where
+    repType =
+      multiAppT ArrowT [ownerType, projectionType]
+      where
+        projectionType =
+          ConT ''Bool
+    fromLabelExp =
+      Lambdas.enumConstructorToBool conName
+
+
+-- * 'HasField'
+-------------------------
+
+{-| The most general template for 'HasField'. -}
+hasField :: TyLit -> Type -> Type -> [Clause] -> Dec
+hasField fieldLabel ownerType projectionType getFieldFunClauses =
+  InstanceD Nothing [] headType [getFieldDec]
+  where
+    headType =
+      multiAppT (ConT ''HasField) [LitT fieldLabel, ownerType, projectionType]
+    getFieldDec =
+      FunD 'getField getFieldFunClauses
+
+{-|
+Field which projects enum values into bools.
+-}
+enumHasField :: TyLit -> Type -> Name -> Dec
+enumHasField fieldLabel ownerType constructorName =
+  hasField fieldLabel ownerType projectionType getFieldFunClauses
+  where
+    projectionType =
+      ConT ''Bool
+    getFieldFunClauses =
+      [matching, unmatching]
+      where
+        matching =
+          Clause [ConP constructorName []] (NormalB bodyExp) []
+          where
+            bodyExp =
+              ConE 'True
+        unmatching =
+          Clause [WildP] (NormalB bodyExp) []
+          where
+            bodyExp =
+              ConE 'False
+
+sumHasField :: TyLit -> Type -> Name -> [Type] -> Dec
+sumHasField fieldLabel ownerType constructorName memberTypes =
+  hasField fieldLabel ownerType projectionType getFieldFunClauses
+  where
+    projectionType =
+      AppT (ConT ''Maybe) (appliedTupleOrSingletonT memberTypes)
+    getFieldFunClauses =
+      [matching, unmatching]
+      where
+        varNames =
+          enumFromTo 1 (length memberTypes) &
+          fmap (mkName . showChar '_' . show)
+        matching =
+          Clause [ConP constructorName pats] (NormalB bodyExp) []
+          where
+            pats =
+              fmap VarP varNames
+            bodyExp =
+              AppE (ConE 'Just) (appliedTupleE (fmap VarE varNames))
+        unmatching =
+          Clause [WildP] (NormalB bodyExp) []
+          where
+            bodyExp =
+              ConE 'Nothing
+
+productHasField :: TyLit -> Type -> Type -> Name -> Int -> Int -> Dec
+productHasField fieldLabel ownerType projectionType constructorName totalMemberTypes offset =
+  hasField fieldLabel ownerType projectionType getFieldFunClauses
+  where
+    getFieldFunClauses =
+      [Clause [ConP constructorName pats] (NormalB bodyExp) []]
+      where
+        pats =
+          replicate offset WildP <>
+          bool empty [VarP aName] (totalMemberTypes > 0) <>
+          replicate (totalMemberTypes - offset - 1) WildP
+        bodyExp =
+          VarE aName
diff --git a/library/THLego/Lambdas.hs b/library/THLego/Lambdas.hs
new file mode 100644
--- /dev/null
+++ b/library/THLego/Lambdas.hs
@@ -0,0 +1,113 @@
+module THLego.Lambdas
+where
+
+import THLego.Prelude
+import THLego.Helpers
+import Language.Haskell.TH
+import qualified TemplateHaskell.Compat.V0208 as Compat
+
+
+{-|
+Simulates lambda-case without the need for extension.
+-}
+matcher :: [Match] -> Exp
+matcher matches =
+  LamE [VarP aName] (CaseE (VarE aName) matches)
+
+{-|
+Lambda expression, which extracts a product member by index.
+-}
+productGetter :: Name -> Int -> Int -> Exp
+productGetter conName numMembers index =
+  LamE [pat] exp
+  where
+    varName =
+      indexName index
+    pat =
+      ConP conName pats
+      where
+        pats =
+          replicate index WildP <>
+          pure (VarP varName) <>
+          replicate (numMembers - index - 1) WildP
+    exp =
+      VarE varName
+
+{-|
+Lambda expression, which sets a product member by index.
+-}
+productSetter :: Name -> Int -> Int -> Exp
+productSetter conName numMembers index =
+  LamE [stateP, valP] exp
+  where
+    valName =
+      mkName "x"
+    stateP =
+      ConP conName pats
+      where
+        pats =
+          fmap (VarP . indexName) (enumFromTo 0 (pred numMembers))
+    valP =
+      VarP valName
+    exp =
+      foldl' AppE (ConE conName) (fmap VarE names)
+      where
+        names =
+          fmap indexName (enumFromTo 0 (pred index)) <>
+          pure valName <>
+          fmap indexName (enumFromTo (succ index) (pred numMembers))
+
+adtConstructorNarrower :: Name -> Int -> Exp
+adtConstructorNarrower conName numMembers =
+  matcher [positive, negative]
+  where
+    positive =
+      Match (ConP conName (fmap VarP varNames)) (NormalB exp) []
+      where
+        varNames =
+          fmap indexName (enumFromTo 0 (pred numMembers))
+        exp =
+          AppE (ConE 'Just) (Compat.tupE (fmap VarE varNames))
+    negative =
+      Match WildP (NormalB (ConE 'Nothing)) []
+
+enumConstructorToBool :: Name -> Exp
+enumConstructorToBool constructorName =
+  matcher [positive, negative]
+  where
+    positive =
+      Match (ConP constructorName []) (NormalB bodyExp) []
+      where
+        bodyExp =
+          ConE 'True
+    negative =
+      Match WildP (NormalB bodyExp) []
+      where
+        bodyExp =
+          ConE 'False
+
+singleConstructorAdtToTuple :: Name -> Int -> Exp
+singleConstructorAdtToTuple conName numMembers =
+  LamE [pat] exp
+  where
+    varNames =
+      fmap indexName (enumFromTo 0 (pred numMembers))
+    pat =
+      ConP conName (fmap VarP varNames)
+    exp =
+      Compat.tupE (fmap VarE varNames)
+
+tupleToProduct :: Name -> Int -> Exp
+tupleToProduct conName numMembers =
+  LamE [pat] exp
+  where
+    varNames =
+      fmap indexName (enumFromTo 0 (pred numMembers))
+    pat =
+      TupP (fmap VarP varNames)
+    exp =
+      multiAppE (ConE conName) (fmap VarE varNames)
+
+namedFieldSetter :: Name -> Exp
+namedFieldSetter fieldName =
+  LamE [VarP aName, VarP bName] (RecUpdE (VarE aName) [(fieldName, VarE bName)])
diff --git a/library/THLego/Prelude.hs b/library/THLego/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/library/THLego/Prelude.hs
@@ -0,0 +1,86 @@
+module THLego.Prelude
+( 
+  module Exports,
+  showAsText,
+)
+where
+
+-- base
+-------------------------
+import Control.Applicative as Exports hiding (WrappedArrow(..))
+import Control.Arrow as Exports hiding (first, second)
+import Control.Category as Exports
+import Control.Concurrent as Exports
+import Control.Exception as Exports
+import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)
+import Control.Monad.IO.Class as Exports
+import Control.Monad.Fail as Exports
+import Control.Monad.Fix as Exports hiding (fix)
+import Control.Monad.ST as Exports
+import Data.Bifunctor as Exports
+import Data.Bits as Exports
+import Data.Bool as Exports
+import Data.Char as Exports
+import Data.Coerce as Exports
+import Data.Complex as Exports
+import Data.Data as Exports
+import Data.Dynamic as Exports
+import Data.Either as Exports
+import Data.Fixed as Exports
+import Data.Foldable as Exports hiding (toList)
+import Data.Function as Exports hiding (id, (.))
+import Data.Functor as Exports
+import Data.Functor.Compose as Exports
+import Data.Functor.Contravariant as Exports
+import Data.Int as Exports
+import Data.IORef as Exports
+import Data.Ix as Exports
+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
+import Data.List.NonEmpty as Exports (NonEmpty(..))
+import Data.Maybe as Exports
+import Data.Monoid as Exports hiding (Alt)
+import Data.Ord as Exports
+import Data.Proxy as Exports
+import Data.Ratio as Exports
+import Data.STRef as Exports
+import Data.String as Exports
+import Data.Traversable as Exports
+import Data.Tuple as Exports
+import Data.Unique as Exports
+import Data.Version as Exports
+import Data.Void as Exports
+import Data.Word as Exports
+import Debug.Trace as Exports
+import Foreign.ForeignPtr as Exports
+import Foreign.Ptr as Exports
+import Foreign.StablePtr as Exports
+import Foreign.Storable as Exports
+import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)
+import GHC.Exts as Exports (IsList(..), lazy, inline, sortWith, groupWith)
+import GHC.Generics as Exports (Generic)
+import GHC.IO.Exception as Exports
+import GHC.OverloadedLabels as Exports
+import GHC.Records as Exports
+import Numeric as Exports
+import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))
+import System.Environment as Exports
+import System.Exit as Exports
+import System.IO as Exports (Handle, hClose)
+import System.IO.Error as Exports
+import System.IO.Unsafe as Exports
+import System.Mem as Exports
+import System.Mem.StableName as Exports
+import System.Timeout as Exports
+import Text.ParserCombinators.ReadP as Exports (ReadP, readP_to_S, readS_to_P)
+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)
+import Text.Printf as Exports (printf, hPrintf)
+import Text.Read as Exports (Read(..), readMaybe, readEither)
+import Unsafe.Coerce as Exports
+
+-- text
+-------------------------
+import Data.Text as Exports (Text)
+
+
+showAsText :: Show a => a -> Text
+showAsText = show >>> fromString
diff --git a/th-lego.cabal b/th-lego.cabal
new file mode 100644
--- /dev/null
+++ b/th-lego.cabal
@@ -0,0 +1,34 @@
+name: th-lego
+version: 0.1
+synopsis: Template Haskell construction utilities
+stability: Experimental
+category: Template Haskell
+homepage: https://github.com/nikita-volkov/th-lego
+bug-reports: https://github.com/nikita-volkov/th-lego/issues
+author: Nikita Volkov <nikita.y.volkov@mail.ru>
+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>
+copyright: (c) 2020 Nikita Volkov
+license: MIT
+license-file: LICENSE
+build-type: Simple
+cabal-version: >=1.10
+
+source-repository head
+  type: git
+  location: git://github.com/nikita-volkov/th-lego.git
+
+library
+  hs-source-dirs: library
+  default-extensions: BangPatterns, BlockArguments, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, DerivingVia, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples
+  default-language: Haskell2010
+  exposed-modules:
+    THLego.Helpers
+    THLego.Instances
+    THLego.Lambdas
+  other-modules:
+    THLego.Prelude
+  build-depends:
+    base >=4.11 && <5,
+    template-haskell >=2.15 && <3,
+    template-haskell-compat-v0208 >=0.1.5 && <0.2,
+    text >=1 && <2