diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,11 @@
+# Changelog for `type-machine`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright 2025 Author name here
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1.  Redistributions of source code must retain the above copyright notice, this
+    list of conditions and the following disclaimer.
+
+2.  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.
+
+3.  Neither the name of the copyright holder nor the names of its 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 HOLDER 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,92 @@
+# Type Machine
+
+TypeScript offers [*Utility Types*](https://www.typescriptlang.org/docs/handbook/utility-types.html), which allows creating a type from another.
+There is no way of doing this in Haskell. You have to maintain all your types yourselves, and handle conversions from one to another yourself.
+
+`type-machine` brings a solution to this problem. Using Template Haskell, generate new types using Type-Script-inspired functions like `omit`, `pick` and `record`.
+It can also generate a conversion type-class that allows you to access fields and convert one type to another.
+
+- Requirements
+    - Requires a couple of language extensions (see example)
+    - Input ADT must have exactly one record constructor
+- Limitations
+    - Does not support type parameters yet
+    - `require` and `partial` only work with `Maybe` fields 
+
+## Examples
+
+```haskell
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+data User = User {
+    id :: Int,
+    name :: String,
+    email :: Maybe String
+}
+
+$(type_ "UserWithEmail" (required ["email"] <::> ''User))
+-- data UserWithEmail = UserWithEmail {
+--     id :: Int,
+--     name :: String,
+--     email :: String
+-- }
+
+$(type_ "UserWithoutId" (omit ["id"] <::> ''User))
+-- data UserWithoutId = UserWithoutId {
+--     name :: String,
+--     email :: String
+-- }
+
+$(type_ "UserId" (pick ["id"] <::> ''User))
+-- data UserId = UserId {
+--     id :: Int
+-- }
+
+$(type_ "Vector3" (record ["x", "y", "z"] [t|Int|]))
+-- data Vector3 = Vector3 {
+--     x :: Int,
+--     y :: Int,
+--     z :: Int
+-- }
+
+-----
+-- Type Parameters
+-----
+
+data MyMaybe a = { content :: Maybe a }
+
+$(type_ "MyString" (apply [t|String|] <::> ''MyMaybe))
+-- data MyString = MyString { 
+--     content :: Maybe String
+-- }
+
+-----
+-- Is
+-----
+
+$(declareIs ''User)
+-- class IsUser a where
+--     getId :: a -> Int
+--     getName :: a -> String
+--     getEmail :: a -> String
+--     setId :: Int -> a -> a
+--     setName :: String -> a -> a
+--     setEmail :: String -> a -> a
+--
+-- instance IsUser User where
+--     getId = id
+--     getName = name
+--     getEmail = email
+--     setId = ...
+--     setName = ...
+--     setEmail = ...
+
+$(type_ "UserWithoutEmail" (omit ["email"] <::> ''User))
+$(deriveIs ''User ''UserWithoutEmail)
+-- instance IsUser UserWithoutEmail where
+--     ...
+
+$(type_ "UserWithoutId" (omit ["id"] <::> ''User))
+$(deriveIs ''User ''UserWithoutId) -- Will fail
+```
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
diff --git a/benchmarks/runtime/Benchmark.hs b/benchmarks/runtime/Benchmark.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/runtime/Benchmark.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
+
+module Benchmark (benchmarks) where
+
+import Control.Lens ((^.))
+import Criterion.Main
+import Data.Functor
+import Gen
+import SuperRecord (get)
+
+$(genWithFieldCount 2)
+$(genWithFieldCount 4)
+$(genWithFieldCount 5)
+$(genWithFieldCount 10)
+$(genWithFieldCount 15)
+$(genWithFieldCount 20)
+
+benchmarks :: [Benchmark]
+benchmarks = [build, traversals]
+
+data Case = TM | SuperRecord | Extensible
+
+buildRecord :: Case -> Int -> ()
+buildRecord c n = flip seq () $ case n of
+    2 -> case c of
+        TM -> field2_1 mkRecordTM2
+        SuperRecord -> get #fSR2_1 mkSuperRRecord2
+        Extensible -> mkExtensibleRecord2 ^. #fE2_1
+    4 -> case c of
+        TM -> field4_1 mkRecordTM4
+        SuperRecord -> get #fSR4_3 mkSuperRRecord4
+        Extensible -> mkExtensibleRecord4 ^. #fE4_3
+    5 -> case c of
+        TM -> field5_1 mkRecordTM5
+        SuperRecord -> get #fSR5_4 mkSuperRRecord5
+        Extensible -> mkExtensibleRecord5 ^. #fE5_4
+    10 -> case c of
+        TM -> field10_9 mkRecordTM10
+        SuperRecord -> get #fSR10_9 mkSuperRRecord10
+        Extensible -> mkExtensibleRecord10 ^. #fE10_9
+    15 -> case c of
+        TM -> field15_14 mkRecordTM15
+        SuperRecord -> get #fSR15_14 mkSuperRRecord15
+        Extensible -> mkExtensibleRecord15 ^. #fE15_14
+    20 -> case c of
+        TM -> field20_19 mkRecordTM20
+        SuperRecord -> get #fSR20_19 mkSuperRRecord20
+        Extensible -> mkExtensibleRecord20 ^. #fE20_19
+    _ -> error "unhandled n"
+
+build :: Benchmark
+build =
+    bgroup
+        "build"
+        $ depths <&> \n ->
+            bgroup
+                (show n)
+                ( cases <&> \(bname, case_) ->
+                    bench bname $
+                        nf
+                            (uncurry buildRecord)
+                            (case_, n)
+                )
+  where
+    depths = [2, 4, 5, 10, 20]
+    cases = [("tm", TM), ("superrecord", SuperRecord), ("extensible", Extensible)]
+
+traversals :: Benchmark
+traversals =
+    bgroup
+        "traverse"
+        [ bgroup
+            "2"
+            [ bench "tm" $ nf sumRecordTM2 mkRecordTM2
+            , bench "superrecord" $ nf sumSuperRRecord2 mkSuperRRecord2
+            , bench "extensible" $ nf sumExtensibleRecord2 mkExtensibleRecord2
+            ]
+        , bgroup
+            "4"
+            [ bench "tm" $ nf sumRecordTM4 mkRecordTM4
+            , bench "superrecord" $ nf sumSuperRRecord4 mkSuperRRecord4
+            , bench "extensible" $ nf sumExtensibleRecord4 mkExtensibleRecord4
+            ]
+        , bgroup
+            "5"
+            [ bench "tm" $ nf sumRecordTM5 mkRecordTM5
+            , bench "superrecord" $ nf sumSuperRRecord5 mkSuperRRecord5
+            , bench "extensible" $ nf sumExtensibleRecord5 mkExtensibleRecord5
+            ]
+        , bgroup
+            "10"
+            [ bench "tm" $ nf sumRecordTM10 mkRecordTM10
+            , bench "superrecord" $ nf sumSuperRRecord10 mkSuperRRecord10
+            , bench "extensible" $ nf sumExtensibleRecord10 mkExtensibleRecord10
+            ]
+        , bgroup
+            "15"
+            [ bench "tm" $ nf sumRecordTM15 mkRecordTM15
+            , bench "superrecord" $ nf sumSuperRRecord15 mkSuperRRecord15
+            , bench "extensible" $ nf sumExtensibleRecord15 mkExtensibleRecord15
+            ]
+        , bgroup
+            "20"
+            [ bench "tm" $ nf sumRecordTM20 mkRecordTM20
+            , bench "superrecord" $ nf sumSuperRRecord20 mkSuperRRecord20
+            , bench "extensible" $ nf sumExtensibleRecord20 mkExtensibleRecord20
+            ]
+        ]
diff --git a/benchmarks/runtime/Gen.hs b/benchmarks/runtime/Gen.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/runtime/Gen.hs
@@ -0,0 +1,195 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
+
+module Gen where
+
+import Control.Monad (forM)
+import Control.Monad.Writer.Strict
+import Data.Extensible
+import Data.Map.Strict (fromList)
+import Language.Haskell.TH hiding (Type)
+import qualified Language.Haskell.TH as TH
+import SuperRecord
+import TypeMachine
+import TypeMachine.Type (Type (Type))
+
+genWithFieldCount :: Int -> Q [Dec]
+genWithFieldCount n = do
+    tm <- genTMRecord n
+    superr <- genSuperrecord n
+    extensible <- genExtensible n
+    return $ tm ++ superr ++ extensible
+
+withNFields :: Int -> String -> (Int -> Q TH.Type) -> TM Type
+withNFields n fieldPrefix getType = do
+    fields <- forM [0 .. n - 1] $ \i -> do
+        let fieldName = fieldPrefix ++ show i
+        fieldType <- lift $ getType i
+        return (fieldName, (Bang NoSourceUnpackedness SourceStrict, fieldType))
+    return (Type (TH.mkName "_") (fromList fields) [])
+
+genTMRecord :: Int -> Q [Dec]
+genTMRecord n = do
+    let tyName = "RecordTM" ++ show n
+    recDef <- type_ tyName $ withNFields n ("field" ++ show n ++ "_") (const [t|Int|])
+    builder <- genTMRecordBuilder tyName n
+    sumF <- genTMRecordSum tyName n
+    return $ recDef ++ builder ++ sumF
+
+genTMRecordBuilder :: String -> Int -> Q [Dec]
+genTMRecordBuilder tyName fieldCount =
+    return
+        [ PragmaD $ InlineP (mkName fName) NoInline FunLike AllPhases
+        , FunD
+            (mkName fName)
+            [Clause [] (NormalB constructorApp) []]
+        ]
+  where
+    constructorApp = foldl (\f arg -> AppE f (LitE $ IntegerL $ fromIntegral arg)) (ConE $ mkName tyName) [0 .. fieldCount - 1]
+    fName = "mk" ++ tyName
+
+genTMRecordSum :: String -> Int -> Q [Dec]
+genTMRecordSum tyName fieldCount = do
+    body_ <- foldl (\rest arg -> [|$rest + $(varE arg)|]) [|0|] fieldVarNames
+    sig <- sigD (mkName fName) [t|$(conT $ mkName tyName) -> Int|]
+    return
+        [ sig
+        , PragmaD $ InlineP (mkName fName) NoInline FunLike AllPhases
+        , FunD (mkName fName) [Clause [pattern_] (NormalB body_) []]
+        ]
+  where
+    pattern_ = ConP (mkName tyName) [] (VarP <$> fieldVarNames)
+    fieldVarNames = mkName . ("f" ++) . show <$> [0 .. fieldCount - 1]
+    fName = "sum" ++ tyName
+
+----------
+
+genSuperrecord :: Int -> Q [Dec]
+genSuperrecord n = do
+    let tyName = "SuperRRecord" ++ show n
+    recDef <- genSuperrecordType tyName n
+    builder <- genSuperrecordBuilder tyName n
+    sum_ <- genSuperrecordSum tyName n
+    return $ recDef : builder ++ sum_
+
+genSuperrecordType :: String -> Int -> Q Dec
+genSuperrecordType tyName fCount = do
+    fields <- forM [0 .. fCount - 1] $ \i -> do
+        let fName = getSuperrecordFieldName fCount i
+        [t|$(return $ LitT $ StrTyLit fName) := Int|]
+    ty <- foldr (\arg rest -> [t|$(return arg) ': $rest|]) (return PromotedNilT) fields
+    return $ TySynD (mkName tyName) [] ty
+
+getSuperrecordFieldName :: Int -> Int -> String
+getSuperrecordFieldName fCount idx = "fSR" ++ show fCount ++ "_" ++ show idx
+
+genSuperrecordBuilder :: String -> Int -> Q [Dec]
+genSuperrecordBuilder tyName fCount = do
+    body_ <-
+        foldr
+            ( \arg rest ->
+                let label = LabelE $ getSuperrecordFieldName fCount arg
+                 in [|$(return label) := ($(litE $ IntegerL $ fromIntegral arg) :: Int) & $rest|]
+            )
+            [|rnil|]
+            [0 .. fCount - 1]
+    sig <- sigD fName [t|SuperRecord.Record $(conT $ mkName tyName)|]
+
+    return
+        [ sig
+        , PragmaD $ InlineP fName NoInline FunLike AllPhases
+        , FunD fName [Clause [] (NormalB body_) []]
+        ]
+  where
+    fName = mkName $ "mk" ++ tyName
+
+genSuperrecordSum :: String -> Int -> Q [Dec]
+genSuperrecordSum tyName fCount = do
+    body_ <-
+        foldl
+            ( \rest arg ->
+                let fieldLabel = labelE $ getSuperrecordFieldName fCount arg
+                    fieldGetter = [|get $fieldLabel $(varE rVar)|]
+                 in [|$rest + $fieldGetter|]
+            )
+            [|0|]
+            [0 .. fCount - 1]
+    sig <- sigD fName [t|SuperRecord.Record $(conT $ mkName tyName) -> Int|]
+    return
+        [ sig
+        , PragmaD $ InlineP fName NoInline FunLike AllPhases
+        , FunD fName [Clause [VarP rVar] (NormalB body_) []]
+        ]
+  where
+    rVar = mkName "r"
+    fName = mkName $ "sum" ++ tyName
+
+--------------
+
+genExtensible :: Int -> Q [Dec]
+genExtensible n = do
+    let tyName = "ExtensibleRecord" ++ show n
+    recTy <- genExtensibleType tyName n
+    builder <- genExtensibleBuilder tyName n
+    sum_ <- genExtensibleSum tyName n
+    return $ recTy ++ builder ++ sum_
+
+getExtensibleFieldName :: Int -> Int -> String
+getExtensibleFieldName fCount idx = "fE" ++ show fCount ++ "_" ++ show idx
+
+genExtensibleType :: String -> Int -> Q [Dec]
+genExtensibleType tyName fCount = do
+    f <- mkField (unwords fieldNames)
+    fields <- forM fieldNames $ \fName -> do [t|$(return $ LitT $ StrTyLit fName) Data.Extensible.:> Int|]
+    fieldsTy <- foldr (\arg rest -> [t|$(return arg) ': $rest|]) (return PromotedNilT) fields
+    let fieldsTyName = mkName $ tyName ++ "Fields"
+    ty <- [t|Data.Extensible.Record $(conT fieldsTyName)|]
+    return $
+        f
+            ++ [ TySynD fieldsTyName [] fieldsTy
+               , TySynD (mkName tyName) [] ty
+               ]
+  where
+    fieldNames = getExtensibleFieldName fCount <$> [0 .. fCount - 1]
+
+genExtensibleBuilder :: String -> Int -> Q [Dec]
+genExtensibleBuilder tyName fCount = do
+    body_ <-
+        foldr
+            ( \arg rest ->
+                let label = LabelE $ getExtensibleFieldName fCount arg
+                 in [|$(return label) @= (($(litE $ IntegerL $ fromIntegral arg)) :: Int) <: $rest|]
+            )
+            [|emptyRecord|]
+            [0 .. fCount - 1]
+
+    sig <- sigD fName [t|$(conT $ mkName tyName)|]
+    return
+        [ sig
+        , PragmaD $ InlineP fName NoInline FunLike AllPhases
+        , FunD fName [Clause [] (NormalB body_) []]
+        ]
+  where
+    fName = mkName $ "mk" ++ tyName
+
+genExtensibleSum :: String -> Int -> Q [Dec]
+genExtensibleSum tyName fCount = do
+    body_ <-
+        foldl
+            ( \rest arg ->
+                let fieldLabel = labelE $ getExtensibleFieldName fCount arg
+                    fieldGetter = [|$(varE rVar) ^. $fieldLabel|]
+                 in [|$rest + $fieldGetter|]
+            )
+            [|0|]
+            [0 .. fCount - 1]
+    sig <- sigD fName [t|$(conT $ mkName tyName) -> Int|]
+    return
+        [ sig
+        , PragmaD $ InlineP fName NoInline FunLike AllPhases
+        , FunD fName [Clause [VarP rVar] (NormalB body_) []]
+        ]
+  where
+    rVar = mkName "r"
+    fName = mkName $ "sum" ++ tyName
diff --git a/benchmarks/runtime/Main.hs b/benchmarks/runtime/Main.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/runtime/Main.hs
@@ -0,0 +1,7 @@
+module Main (main) where
+
+import qualified Benchmark
+import Criterion.Main
+
+main :: IO ()
+main = defaultMain Benchmark.benchmarks
diff --git a/examples/Vector.hs b/examples/Vector.hs
new file mode 100644
--- /dev/null
+++ b/examples/Vector.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+
+module Main (main) where
+
+import TypeMachine
+
+$(type_ "Vector2" (record ["x", "y"] [t|Int|]))
+$(defineIs ''Vector2)
+
+$(type_ "Vector3" (union <::> ''Vector2 <:> record ["z"] [t|Int|]))
+$(deriveIs ''Vector2 ''Vector3)
+
+translateX :: (IsVector2 a) => Int -> a -> a
+translateX n v = setX (n + getX v) v
+
+main :: IO ()
+main = return ()
diff --git a/src/TypeMachine.hs b/src/TypeMachine.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine.hs
@@ -0,0 +1,28 @@
+module TypeMachine (
+    -- * Entrypoint
+    type_,
+
+    -- * Main Type Functions
+    module TypeMachine.Functions,
+
+    -- * Is
+    defineIs,
+    deriveIs,
+
+    -- * Infixes
+    (<:>),
+    (<::>),
+    (<.>),
+
+    -- * Internal types
+    Type,
+    TM,
+
+    -- * Log types
+) where
+
+import TypeMachine.Functions
+import TypeMachine.TH
+import TypeMachine.TM
+import TypeMachine.TM.Syntax
+import TypeMachine.Type
diff --git a/src/TypeMachine/Functions.hs b/src/TypeMachine/Functions.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/Functions.hs
@@ -0,0 +1,290 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module TypeMachine.Functions (
+    -- * Fields
+    pick,
+    omit,
+
+    -- * Record
+    record,
+
+    -- * Union and Intersection
+    intersection,
+    intersection',
+    union,
+    union',
+
+    -- * Optional
+    require,
+    partial,
+    partial',
+
+    -- * Type Parameters
+    apply,
+    applyMany,
+
+    -- * Utils
+    keysOf,
+)
+where
+
+import Control.Arrow (Arrow (second))
+import Control.Monad (foldM, forM, unless, when)
+import Control.Monad.Writer.Strict
+import qualified Data.Foldable as Set
+import Data.Generics
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import Language.Haskell.TH hiding (Type, bang)
+import qualified Language.Haskell.TH as TH
+import TypeMachine.Internal.Utils
+import TypeMachine.Log
+import TypeMachine.TM
+import TypeMachine.Type
+
+-- | Mark fields are required
+--
+-- @
+--  > data A = A { a :: Maybe Int, b :: Int }
+--  > require ["a"] '<:>' 'toType' ''A
+--
+--  data _ = { a :: Int, b :: Int }
+-- @
+require :: [String] -> Type -> TM Type
+require fieldsNameToRequire ty = do
+    logUnknownFields fieldsNameToRequire ty
+    updatedFields <- mapM (uncurry markAsRequired) (Map.toList $ fields ty)
+    return ty{fields = Map.fromList updatedFields}
+  where
+    -- TODO Handle any type that is monadplus
+    markAsRequired n (b, AppT (ConT p) t)
+        | n `elem` fieldsNameToRequire && nameBase p == "Maybe" = return (n, (b, t))
+    markAsRequired n r
+        | n `elem` fieldsNameToRequire = addLog (fieldNotOptional n) >> return (n, r)
+    markAsRequired n r = return (n, r)
+
+-- | Pick/Select fields by name
+--
+-- Issues a warning when a key is not in the input 'Type'
+--
+-- @
+--  > data A = A { a :: Int, b :: Int }
+--  > pick ["a", "c"] '<:>' 'toType' ''A
+--
+--  data _ = { a :: Int }
+-- @
+pick :: [String] -> Type -> TM Type
+pick namesToPick ty = do
+    failIfHasTypeVariables ty
+    logUnknownFields namesToPick ty
+    let finalType = ty{fields = keepKeys namesToPick (fields ty)}
+    logIfEmptyType finalType
+    return finalType
+
+-- | Remove fields by name
+--
+-- Issues a warning when a key is not in the input 'Type'
+--
+-- @
+--  > data A = A { a :: Int, b :: Int }
+--  > omit ["b", "c"] '<:>' 'toType' ''A
+--
+--  data _ = { a :: Int }
+-- @
+omit :: [String] -> Type -> TM Type
+omit namesToOmit ty = do
+    failIfHasTypeVariables ty
+    logUnknownFields namesToOmit ty
+    let resultType = ty{fields = removeKeys namesToOmit (fields ty)}
+    logIfEmptyType resultType
+    return resultType
+
+-- | Keep the fields present in both types
+--
+--  If keys overlap, prefer the type of the left type
+--
+-- @
+--  > data A = A { a :: Int, b :: Int }
+--  > data B = B { b :: String, c :: Void }
+--  > intersection '<:>' 'toType' ''A  <:> 'toType' ''B
+--
+--  data _ = { b :: Int }
+-- @
+intersection :: Type -> Type -> TM Type
+intersection a b = do
+    failIfHasTypeVariables a
+    failIfHasTypeVariables b
+    let finalType = a{fields = Map.intersection (fields a) (fields b)}
+    logIfEmptyType finalType
+    return finalType
+
+-- | Keep the fields present in both types
+--
+--  If keys overlap, prefer the type of the right type
+--
+-- @
+--  > data A = A { a :: Int, b :: Int }
+--  > data B = B { b :: String, c :: Void }
+--  > intersection' '<:>' 'toType' ''A  <:> 'toType' ''B
+--
+--  data _ = { b :: String }
+-- @
+intersection' :: Type -> Type -> TM Type
+intersection' = flip intersection
+{-# INLINE intersection' #-}
+
+-- | Merge two types together
+--
+--  If keys overlap, prefer the type of the left type
+--
+-- @
+--  > data A = A { a :: Int, b :: Int }
+--  > data B = B { b :: String, c :: Void }
+--  > union '<:>' 'toType' ''A  <:> 'toType' ''B
+--
+--  data _ = { a :: Int, b :: Int, c :: Void }
+-- @
+union :: Type -> Type -> TM Type
+union a b = do
+    failIfHasTypeVariables a
+    failIfHasTypeVariables b
+    return $ a{fields = Map.union (fields a) (fields b)}
+
+-- | Merge two types together
+--
+--  If keys overlap, prefer the type of the right type
+--
+-- @
+--  > data A = A { a :: Int, b :: Int }
+--  > data B = B { b :: String, c :: Void }
+--  > union '<:>' 'toType' ''A  <:> 'toType' ''B
+--
+--  data _ = { a :: Int, b :: String, c :: Void }
+-- @
+union' :: Type -> Type -> TM Type
+union' = flip union
+{-# INLINE union' #-}
+
+-- | Get the names of the fields in in type
+--
+-- @
+--  > data A = A { a :: Int, b :: Int }
+--  > keysOf '<:>' 'toType' ''A
+--
+--  ["a", "b"]
+-- @
+keysOf :: Type -> TM [String]
+keysOf = return . Map.keys . fields
+
+-- | Marks all fields as 'Maybe'
+--
+--  Fields that already have a 'Maybe' type will not be changed.
+--
+-- @
+--  > data A = A { a :: Int, b :: Maybe Int }
+--  > partial '<:>' toType ''A
+--
+--  data _ = { a :: Maybe Int, b :: Maybe Int }
+-- @
+partial :: Type -> TM Type
+partial = partial_ False
+
+-- | Similar to 'partial'. Marks all fields as 'Maybe'
+--
+--  Fields that already have a 'Maybe' type will be wrapped in a 'Maybe'
+--
+-- @
+--  > data A = A { a :: Int, b :: Maybe Int }
+--  > partial' '<:>' toType ''A
+--
+--  data _ = { a :: Maybe Int, b :: Maybe (Maybe Int) }
+-- @
+partial' :: Type -> TM Type
+partial' = partial_ True
+
+partial_ :: Bool -> Type -> TM Type
+partial_ rewrapMaybes ty = do
+    nullableFields <- forM (fields ty) $ \field@(b, t) -> case t of
+        AppT (ConT w) _ | nameBase w == "Maybe" && not rewrapMaybes -> return field
+        _ -> lift $ (b,) <$> [t|Maybe $(return t)|]
+    return ty{fields = nullableFields}
+
+-- | Creates a type from a list of keys and a 'ToFieldType'
+--
+-- Issues a log if some keys are duplicated
+--
+-- @
+--  > record ["a", "b"] [t|Int|]
+--
+--  data _ = { a :: Int, b :: Int }
+-- @
+record :: [String] -> Q TH.Type -> TM Type
+record fNames t = do
+    when (Set.length fNameSet /= length fNames) $
+        addLog duplicateKey
+    when (null fNames) $
+        addLog emptyResultType
+    fType <- lift t
+    return $ Type (mkName "_") (Map.fromSet (const (bang, fType)) fNameSet) []
+  where
+    bang = Bang NoSourceUnpackedness NoSourceStrictness
+    fNameSet = Set.fromList fNames
+
+-- | Replaces the first type parameter with the given type
+--
+-- Issues a warning if there are no type variable
+--
+-- @
+--
+--  data A x = { a :: Maybe x }
+--
+--  > 'apply' [t|Int|] \<:\> 'toType' ''A
+--
+--  data _ = { a :: Maybe Int }
+-- @
+apply :: Q TH.Type -> Type -> TM Type
+apply _ ty@(Type _ _ []) = addLogs [noTypeParameter] >> return ty
+apply qt ty@(Type _ f ((tp, _) : tps)) = do
+    typeParameterValue <- lift qt
+    let fieldsWithTypeApplied = second (replaceTypeVar tp typeParameterValue) <$> f
+    return ty{fields = fieldsWithTypeApplied, typeParams = tps}
+  where
+    replaceTypeVar varName value src =
+        let
+            mapper t@(VarT n) =
+                if nameBase n == varName
+                    then value
+                    else t
+            mapper t = t
+         in
+            everywhere (mkT mapper) src
+
+-- | Applies multiple type arguments
+--
+-- Issues a warning if too many arguments are given
+--
+-- @
+--
+--  data A a b = { a :: Maybe a, b :: b }
+--
+--  > 'applyMany' ([t|Int|], [t|String|]) \<:\> 'toType' ''A
+--
+--  data _ = { a :: Maybe Int, b :: String }
+-- @
+applyMany :: [Q TH.Type] -> Type -> TM Type
+applyMany typeArgs ty = foldM (flip apply) ty typeArgs
+
+-- Utils for logs
+
+logUnknownFields :: [String] -> Type -> TM ()
+logUnknownFields fieldNames ty =
+    addLogs $
+        fieldNotInType <$> filter (\fName -> not (fName `hasField` ty)) fieldNames
+
+logIfEmptyType :: Type -> TM ()
+logIfEmptyType ty = when (Map.null $ fields ty) $ addLog emptyResultType
+
+failIfHasTypeVariables :: Type -> TM ()
+failIfHasTypeVariables ty =
+    unless (null $ typeParams ty) $
+        fail "Warning - The behaviour of this function is not tested on types with type parameters."
diff --git a/src/TypeMachine/Infix.hs b/src/TypeMachine/Infix.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/Infix.hs
@@ -0,0 +1,78 @@
+module TypeMachine.Infix (
+    -- * Intersection
+    (<#|>),
+    (<:#|>),
+    (<#|:>),
+
+    -- ** Flipped Intersection
+    (<|#>),
+    (<:|#>),
+    (<|#:>),
+
+    -- * Union
+    (<#&>),
+    (<:#&>),
+    (<#&:>),
+
+    -- ** Flipped Union
+    (<&#>),
+    (<:&#>),
+    (<&#:>),
+) where
+
+import Language.Haskell.TH (Name)
+import TypeMachine.Functions
+import TypeMachine.TM
+import TypeMachine.Type
+
+-- | Alias to 'intersection'
+(<#|>) :: Type -> Type -> TM Type
+(<#|>) = intersection
+{-# INLINE (<#|>) #-}
+
+-- | Like '<#|>', but the first parameter is a name
+(<:#|>) :: Name -> Type -> TM Type
+a <:#|> b = toType a >>= \a' -> a' <#|> b
+
+-- | Like '<#|>', but the second parameter is a name
+(<#|:>) :: Type -> Name -> TM Type
+a <#|:> b = toType b >>= \b' -> a <#|> b'
+
+-- | Alias to 'intersection''
+(<|#>) :: Type -> Type -> TM Type
+(<|#>) = intersection'
+{-# INLINE (<|#>) #-}
+
+-- | Like '<|#>', but the first parameter is a name
+(<:|#>) :: Name -> Type -> TM Type
+a <:|#> b = toType a >>= \a' -> a' <|#> b
+
+-- | Like '<|#>', but the second parameter is a name
+(<|#:>) :: Type -> Name -> TM Type
+a <|#:> b = toType b >>= \b' -> a <|#> b'
+
+-- | Alias to 'union'
+(<#&>) :: Type -> Type -> TM Type
+(<#&>) = union
+{-# INLINE (<#&>) #-}
+
+-- | Like '<#&>', but the first parameter is a name
+(<:#&>) :: Name -> Type -> TM Type
+a <:#&> b = toType a >>= \a' -> a' <#&> b
+
+-- | Like '<#&>', but the second parameter is a name
+(<#&:>) :: Type -> Name -> TM Type
+a <#&:> b = toType b >>= \b' -> a <#&> b'
+
+-- | Alias to 'union''
+(<&#>) :: Type -> Type -> TM Type
+(<&#>) = union'
+{-# INLINE (<&#>) #-}
+
+-- | Like '<&#>', but the first parameter is a name
+(<:&#>) :: Name -> Type -> TM Type
+a <:&#> b = toType a >>= \a' -> a' <&#> b
+
+-- | Like '<&#>', but the second parameter is a name
+(<&#:>) :: Type -> Name -> TM Type
+a <&#:> b = toType b >>= \b' -> a <&#> b'
diff --git a/src/TypeMachine/Internal/Utils.hs b/src/TypeMachine/Internal/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/Internal/Utils.hs
@@ -0,0 +1,9 @@
+module TypeMachine.Internal.Utils (removeKeys, keepKeys) where
+
+import qualified Data.Map.Strict as Map
+
+removeKeys :: (Eq k) => [k] -> Map.Map k v -> Map.Map k v
+removeKeys keys = Map.filterWithKey (\k _ -> k `notElem` keys)
+
+keepKeys :: (Eq k) => [k] -> Map.Map k v -> Map.Map k v
+keepKeys keys = Map.filterWithKey (\k _ -> k `elem` keys)
diff --git a/src/TypeMachine/Log.hs b/src/TypeMachine/Log.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/Log.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE GADTs #-}
+
+module TypeMachine.Log (
+    TypeMachineLog,
+
+    -- * Common Log messages
+    fieldNotInType,
+    emptyResultType,
+    fieldNotOptional,
+    duplicateKey,
+    noTypeParameter,
+
+    -- * Formatting
+    formatLog,
+) where
+
+type TypeMachineLog = String
+
+-- | Format a log message, to be printed to the user
+formatLog :: TypeMachineLog -> String
+formatLog = (++) "TypeMachine: "
+
+fieldNotInType :: String -> TypeMachineLog
+fieldNotInType f = "Field '" ++ f ++ "' not in type."
+
+emptyResultType :: TypeMachineLog
+emptyResultType = "Result type is empty."
+
+fieldNotOptional :: String -> TypeMachineLog
+fieldNotOptional f = "Field '" ++ f ++ "' is not optional."
+
+noTypeParameter :: TypeMachineLog
+noTypeParameter = "There are no type parameters in this type."
+
+duplicateKey :: TypeMachineLog
+duplicateKey = "Some keys are duplicated."
diff --git a/src/TypeMachine/TH.hs b/src/TypeMachine/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/TH.hs
@@ -0,0 +1,13 @@
+module TypeMachine.TH (type_, deriveIs, defineIs) where
+
+import Language.Haskell.TH hiding (Type, reifyType)
+import TypeMachine.TH.Is
+import TypeMachine.TM (TM, runTM)
+import TypeMachine.Type
+
+-- | Entrypoint of TypeMachine. Create a new data type using a 'TM' computation
+type_ :: String -> TM Type -> Q [Dec]
+type_ newTyName t = do
+    fRes <- runTM t
+    let newType = fRes{name = mkName newTyName}
+    return [typeToDec newType]
diff --git a/src/TypeMachine/TH/Internal/Utils.hs b/src/TypeMachine/TH/Internal/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/TH/Internal/Utils.hs
@@ -0,0 +1,18 @@
+module TypeMachine.TH.Internal.Utils (capitalize, getRecordConstructorVars) where
+
+import Data.Char (toUpper)
+import Language.Haskell.TH hiding (Type, reifyType)
+
+-- | Capitalize the first letter of a string
+capitalize :: String -> String
+capitalize (c : cs) = toUpper c : cs
+capitalize cs = cs
+
+-- From a 'DataD''s constructors, returns its unique constructor's fields.
+--
+-- Fails if the list of 'Con' does not have exactly one record constructor
+getRecordConstructorVars :: (MonadFail m) => [Con] -> m [VarBangType]
+getRecordConstructorVars [RecC _ vbt] = return vbt
+getRecordConstructorVars _ = fail "Type-Machine Error: Expected type to have exactly one Record constructor"
+
+-- TODO I don't like passing [Con] as parameter. Might need to redesign this function
diff --git a/src/TypeMachine/TH/Is.hs b/src/TypeMachine/TH/Is.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/TH/Is.hs
@@ -0,0 +1,221 @@
+module TypeMachine.TH.Is (isClassName, deriveIs, defineIs) where
+
+import Control.Monad (MonadPlus (mzero), forM)
+import qualified Data.Map.Strict as Map
+import Language.Haskell.TH hiding (Type, reifyType)
+import qualified Language.Haskell.TH as TH
+import Text.Printf
+import TypeMachine.TH.Internal.Utils
+import TypeMachine.Type (fields, reifyType)
+
+-- | Get the name of the 'Is' class generated for the given type
+--
+-- @
+-- > isClassName ''User
+--   IsUser
+-- @
+isClassName :: Name -> Name
+isClassName = mkName . ("Is" ++) . capitalize . nameBase
+
+-- | Get the name of the 'to' function generated for the given type
+--
+-- @
+-- > toFuncName ''User
+--   toUser
+-- @
+toFuncName :: Name -> Name
+toFuncName = mkName . ("to" ++) . capitalize . nameBase
+
+-- | Returns the declaration of the instance of 'Is' for a given type
+--
+-- @
+--  > deriveIs ''Animal ''Dog
+--
+--    instance IsAnimal Dog where
+--       ...
+-- @
+deriveIs :: Name -> Name -> Q [Dec]
+deriveIs sourceTypeName destTypeName = do
+    destFields <- fields <$> reifyType destTypeName
+    sourceFields <- fields <$> reifyType sourceTypeName
+    let className = mkName ("Is" ++ nameBase sourceTypeName)
+    classFuncs <- fmap concat $ forM (zip [0 ..] $ Map.toList sourceFields) $ \(i, (n, (_, t))) ->
+        case Map.lookup n destFields of
+            Just _ -> do
+                getter <- fieldToGetter n
+                setter <- fieldToSetter (length destFields) i n
+                return [getter, setter]
+            Nothing ->
+                ifM
+                    (fieldIsOptional t)
+                    ( do
+                        getter <- fieldNameToMemptyFunDec n
+                        setter <- fieldNameToNoopFunDec n
+                        return [getter, setter]
+                    )
+                    ( fail
+                        ( printf
+                            "Type-Machine Error: Cannot define instance of %s for %s. Field '%s' is missing in %s "
+                            (nameBase className)
+                            destTypeStr
+                            n
+                            destTypeStr
+                        )
+                    )
+    let inlinePragmas = mkInlinePragmas $ Map.keys sourceFields
+        instanceDec =
+            InstanceD
+                Nothing
+                []
+                (AppT (ConT className) (ConT destTypeName))
+                (inlinePragmas ++ classFuncs)
+    return [instanceDec]
+  where
+    destTypeStr = nameBase destTypeName
+    fieldNameToMemptyFunDec n =
+        funD (mkName $ fieldNameToIsGetter n) [clause [] (normalB [|const mzero|]) []]
+
+    fieldNameToNoopFunDec n =
+        funD
+            (mkName $ fieldNameToIsSetter n)
+            [clause [wildP, varP inputObjName] (normalB $ varE inputObjName) []]
+      where
+        inputObjName = mkName "x"
+    fieldToGetter n = do
+        let funName = mkName $ fieldNameToIsGetter n
+            resName = mkName "res"
+            expr = [|$(varE resName)|]
+        -- Note: using destTypeName makes Q think that we use the type, not the constructor
+        funD
+            funName
+            [clause [return $ RecP (mkName destTypeStr) [(mkName n, VarP resName)]] (normalB expr) []]
+
+    fieldToSetter fieldCount fieldPos fieldName = do
+        fieldsNames <-
+            forM
+                [0 .. (fieldCount - 1)]
+                ( \i ->
+                    if i == fieldPos
+                        then return $ mkName "_"
+                        else newName $ "f" ++ show i
+                )
+        let funName = mkName $ fieldNameToIsSetter fieldName
+        let newValueName = mkName "new"
+        let patt = ConP (mkName destTypeStr) [] (VarP <$> fieldsNames)
+        let body =
+                foldl
+                    ( \res f ->
+                        res `AppE` case nameBase f of
+                            "_" -> VarE newValueName
+                            _ -> VarE f
+                    )
+                    (ConE $ mkName destTypeStr)
+                    fieldsNames
+
+        funD funName [clause [varP newValueName, return $ patt] (normalB $ return body) []]
+    -- TODO handle non-parametric monadplus-es
+    -- Returns true is field is instance of Monad plus
+    fieldIsOptional :: TH.Type -> Q Bool
+    fieldIsOptional (AppT t _) = isInstance ''MonadPlus [t]
+    fieldIsOptional _ = return False
+    ifM mbool t f = do bool <- mbool; if bool then t else f
+    mkInlinePragmas :: [String] -> [Dec]
+    mkInlinePragmas fieldNames = mkInlinePragma . mkName <$> setterAndGetterNames
+      where
+        setterAndGetterNames =
+            foldr
+                (\field rest -> fieldNameToIsSetter field : fieldNameToIsGetter field : rest)
+                []
+                fieldNames
+        mkInlinePragma fName = PragmaD $ InlineP fName Inline FunLike AllPhases
+
+----- Definition
+
+-- | Define the 'Is' class for the given type and generate the 'To' function
+--
+-- @
+--  > data User = User { id :: Int, name :: String }
+--  > defineIs ''User
+--
+--  class IsUser a where
+--       getId :: a -> Int
+--       getName :: a -> String
+--
+--       setId :: Int -> a -> a
+--       setName :: String -> a -> a
+--
+--       toUser :: (IsUser a) => a -> User
+--       toUser a = User (getId a) (getName a)
+--
+--  instance IsUser User where
+--       ...
+--
+-- @
+defineIs :: Name -> Q [Dec]
+defineIs tyName = do
+    ty <- reifyType tyName
+    classTypeVar <- newName "a"
+    getters <- mapM (vbtToGetter classTypeVar) (Map.toList $ fields ty)
+    setters <- mapM (vbtToSetter classTypeVar) (Map.toList $ fields ty)
+    to <- defineTo tyName classTypeVar
+    isItself <- deriveIs tyName tyName
+    return $
+        ClassD
+            []
+            (isClassName tyName)
+            [PlainTV classTypeVar BndrReq]
+            []
+            (getters ++ setters ++ to)
+            : isItself
+  where
+    -- vbtToGetter a id Int == getId :: a -> Int
+    vbtToGetter :: Name -> (String, BangType) -> Q Dec
+    vbtToGetter classtypeVar (n, (_, t)) =
+        let
+            memberName = mkName $ fieldNameToIsGetter n
+         in
+            sigD memberName [t|$(varT classtypeVar) -> $(return t)|]
+
+    -- vbtToSetter a id Int == setId ::  Int -> a -> a
+    vbtToSetter :: Name -> (String, BangType) -> Q Dec
+    vbtToSetter classtypeVar (n, (_, t)) =
+        let
+            memberName = mkName $ fieldNameToIsSetter n
+         in
+            sigD memberName [t|$(return t) -> $(varT classtypeVar) -> $(varT classtypeVar)|]
+
+-- | Generate the 'To' function
+--
+-- @
+--  > data User = User { id :: Int, name :: String }
+--
+--  toUser :: (IsUser a) => a -> User
+--  toUser from = User (getId from) (getName from)
+-- @
+defineTo :: Name -> Name -> Q [Dec]
+defineTo tyName tyVarName = do
+    ty <- reifyType tyName
+    toFuncType <-
+        sigD
+            toName
+            [t|$(varT tyVarName) -> $(conT tyName)|]
+    toFuncBody <-
+        let
+            from = mkName "from"
+            app =
+                foldl'
+                    (\r n -> [|$r ($(varE $ mkName $ fieldNameToIsGetter n) $(varE from))|])
+                    (conE $ mkName $ nameBase tyName)
+                    (Map.keys $ fields ty)
+         in
+            funD (toFuncName tyName) [clause [varP from] (normalB app) []]
+    return [toFuncType, toFuncBody]
+  where
+    toName = toFuncName tyName
+
+-- Internal
+fieldNameToIsGetter :: String -> String
+fieldNameToIsGetter = ("get" ++) . capitalize
+
+fieldNameToIsSetter :: String -> String
+fieldNameToIsSetter = ("set" ++) . capitalize
diff --git a/src/TypeMachine/TM.hs b/src/TypeMachine/TM.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/TM.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE ImpredicativeTypes #-}
+
+module TypeMachine.TM (
+    -- * Monad
+    TM,
+    runTM,
+    execTM,
+
+    -- * Logging
+    addLog,
+    addLogs,
+
+    -- * Utils
+    toType,
+) where
+
+import Control.Monad (forM_)
+import Control.Monad.Writer.Lazy
+import Language.Haskell.TH hiding (Type, reifyType)
+import TypeMachine.Log
+import TypeMachine.Type
+
+-- | The 'TM' (*TypeMachine*) monad can:
+--
+-- - Emit warning messages (e.g. when omitting that does not exist)
+-- - Take advantage of the 'Language.Haskell.TH.Q' monad's features
+type TM a = WriterT [TypeMachineLog] Q a
+
+-- | Add a log message to issue
+addLog :: TypeMachineLog -> TM ()
+addLog l = tell [l]
+
+addLogs :: [TypeMachineLog] -> TM ()
+addLogs = tell
+
+-- | Execute a 'TM' computation and issue logs using the 'Q' monad
+runTM :: TM a -> Q a
+runTM t = do
+    (res, logs) <- runWriterT t
+    forM_ logs $ reportWarning . formatLog
+    return res
+
+-- | Runs a 'TM', returns the logs to issue and the computation result
+execTM :: TM a -> Q (a, [TypeMachineLog])
+execTM = runWriterT
+
+-- | Takes an ADT name, returns the `Type` for that ADT
+--
+-- A utilitary function to use 'reifyType' in the 'TM' monad
+toType :: Name -> TM Type
+toType = lift . reifyType
diff --git a/src/TypeMachine/TM/Liftable.hs b/src/TypeMachine/TM/Liftable.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/TM/Liftable.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeOperators #-}
+
+module TypeMachine.TM.Liftable (LiftableTMFunction (applyTM)) where
+
+import TypeMachine.TM
+
+class LiftableTMFunction f where
+    applyTM :: forall a b. (f ~ (a -> b)) => (a -> b) -> TM a -> b
+
+instance LiftableTMFunction (a -> TM b) where
+    applyTM f v = v >>= f
+
+instance LiftableTMFunction (a -> b -> TM c) where
+    applyTM f ma b = do
+        a <- ma
+        f a b
+
+instance LiftableTMFunction (a -> b -> c -> TM d) where
+    applyTM f ma b c = do
+        a <- ma
+        f a b c
+
+instance LiftableTMFunction (a -> b -> c -> d -> TM e) where
+    applyTM f ma b c d = do
+        a <- ma
+        f a b c d
diff --git a/src/TypeMachine/TM/Syntax.hs b/src/TypeMachine/TM/Syntax.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/TM/Syntax.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module TypeMachine.TM.Syntax ((<:>), (<::>), (<.>)) where
+
+import Language.Haskell.TH (Name)
+import TypeMachine.TM
+import TypeMachine.TM.Liftable
+import TypeMachine.Type
+
+-- | Apply a `TM a` value to a 'TM' computation that expects an `a`
+--
+-- Example:
+--
+-- @
+--  'omit' ["id"] '<:>' 'toType' ''User
+-- @
+(<:>) :: (LiftableTMFunction (a -> b)) => (a -> b) -> TM a -> b
+(<:>) = applyTM
+
+-- | Allows passing a name to a 'TM' function that takes a 'Type'
+--
+-- @
+--  f '<::>' ''User == f '<:>' 'toType' ''User
+-- @
+(<::>) :: (LiftableTMFunction (Type -> a)) => (Type -> a) -> Name -> a
+f <::> n = f <:> toType n
+
+-- | Apply a `a` value to a 'TM' computation that expects an `a`.
+--
+-- It is just an application operator. It exists so that applications of 'TM' functions is visually homogeneous
+-- Not using it when `a` is the first parameter can enhance readability.
+--
+-- Examples:
+--
+-- @
+--  'omit' '<.>' ["id"] '<:>' 'toType' ''User
+--  -- Is equivalent to
+--  'omit' ["id"] '<:>' 'toType' ''User
+-- @
+--
+-- If the parameters to this function were flipped, using '<.>' can be handy:
+--
+-- @
+--  'flip' 'omit' '<:>' 'toType' ''User '<.>' ["id"]
+--  -- Instead of having to use parenthesis
+--  ('flip' 'omit' '<:>' 'toType' ''User) ["id"]
+--  -- Or the application operator:
+--  'flip' 'omit' '<:>' 'toType' ''User $ ["id"]
+-- @
+(<.>) :: (a -> b) -> a -> b
+f <.> v = f v
diff --git a/src/TypeMachine/Type.hs b/src/TypeMachine/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/TypeMachine/Type.hs
@@ -0,0 +1,88 @@
+module TypeMachine.Type (
+    Type (..),
+    getField,
+    hasField,
+    typeToDec,
+    decToType,
+    reifyType,
+) where
+
+import Data.Bifunctor (first)
+import Data.Functor ((<&>))
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Language.Haskell.TH.Syntax hiding (Type, reifyType)
+import qualified Language.Haskell.TH.Syntax as TH (Type)
+import TypeMachine.TH.Internal.Utils
+
+-- | Data structure to easily manipulate Template Haskell's 'Language.Haskell.TH.Dec.DataD'
+data Type = Type
+    { name :: Name
+    -- ^ Name of the data type
+    , fields :: Map String BangType
+    -- ^ Fields of the data type
+    , typeParams :: [(String, Maybe Kind)]
+    -- ^ Type parameter of the ADT
+    }
+    deriving (Show, Eq)
+
+getField :: String -> Type -> Maybe (Bang, TH.Type)
+getField fieldName ty = Map.lookup fieldName (fields ty)
+
+hasField :: String -> Type -> Bool
+hasField n t = Map.member n $ fields t
+
+-- | Turns a 'Type' back to a Template Haskell 'Language.Haskell.TH.Dec'
+typeToDec :: Type -> Dec
+typeToDec (Type n fs tp) =
+    DataD
+        []
+        n
+        (tpToTyVarBndrs . first mkName <$> tp)
+        Nothing
+        [RecC (mkName $ nameBase n) $ fieldsToVbt fs]
+        []
+  where
+    tpToTyVarBndrs (varName, Nothing) = PlainTV varName BndrInvis
+    tpToTyVarBndrs (varName, Just k) = KindedTV varName BndrInvis k
+
+-- | Transform a Template Haskell 'Dec' into a TypeMachine's type
+--
+-- For this to succeed, the input type must have exactly one record constructor
+decToType :: (Quasi m) => Dec -> m Type
+decToType dec = do
+    (tyName, tyBndrs, cons) <- case dec of
+        (TySynD _ _ (ConT tyconsName)) -> do
+            tyconsInfo <- runQ $ reify tyconsName
+            case tyconsInfo of
+                TyConI dec' -> getTyInfo dec'
+                _ -> fail failMsg
+        _ -> getTyInfo dec
+    vbt <- getRecordConstructorVars cons
+    let tparams =
+            tyBndrs <&> \case
+                PlainTV n _ -> (n, Nothing)
+                KindedTV n _ k -> (n, Just k)
+    return $ Type tyName (vbtToFields vbt) (first nameBase <$> tparams)
+  where
+    failMsg = "Unsupported data type: Expected record type with exactly one constructor"
+    getTyInfo decl = case decl of
+        (DataD _ tyName tybndrs _ cons _) -> return (tyName, tybndrs, cons)
+        (NewtypeD _ tyName tybndrs _ con _) -> return (tyName, tybndrs, [con])
+        _ -> fail failMsg
+
+-- | Wrapper around the TH's 'reify' function. Fails if the type is not a datatype declaration
+reifyType :: Name -> Q Type
+reifyType n = do
+    res <- reify n
+    case res of
+        TyConI ty -> decToType ty
+        _ -> fail "Invalid Name. Expected Datatype declaration"
+
+{-# INLINE fieldsToVbt #-}
+fieldsToVbt :: Map String BangType -> [VarBangType]
+fieldsToVbt = Map.foldrWithKey (\key (b, t) list -> (mkName key, b, t) : list) []
+
+{-# INLINE vbtToFields #-}
+vbtToFields :: [VarBangType] -> Map String BangType
+vbtToFields = Map.fromList . fmap (\(n, b, t) -> (nameBase n, (b, t)))
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/test/TypeMachine/FunctionsSpec.hs b/test/TypeMachine/FunctionsSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/TypeMachine/FunctionsSpec.hs
@@ -0,0 +1,227 @@
+module TypeMachine.FunctionsSpec (spec) where
+
+import Control.Exception.Base
+import Control.Monad
+import Data.Either (isLeft)
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import Language.Haskell.TH hiding (bang)
+import Test.Hspec
+import TypeMachine
+import TypeMachine.Log
+import TypeMachine.TM (execTM)
+import TypeMachine.Type (Type (..))
+
+spec :: Spec
+spec =
+    describe
+        "Functions"
+        $ do
+            let bang = Bang NoSourceUnpackedness NoSourceStrictness
+                idKey = "id"
+                nameKey = "name"
+                otherPropKey = "otherProp"
+                userIdType = (bang, ConT $ mkName "Int")
+                userNameType = (bang, ConT $ mkName "String")
+                userOtherPropRequiredType = ConT $ mkName "String"
+                userOtherPropType = (bang, AppT (ConT $ mkName "Maybe") userOtherPropRequiredType)
+                typeWithVar =
+                    Type
+                        (mkName "TypeWithVar")
+                        ( Map.fromList
+                            [ ("a", (bang, VarT $ mkName "a"))
+                            ,
+                                ( "b"
+                                ,
+                                    ( bang
+                                    , ConT (mkName "Maybe")
+                                        `AppT` ( ConT (mkName "Maybe")
+                                                    `AppT` VarT (mkName "b")
+                                               )
+                                    )
+                                )
+                            ]
+                        )
+                        [("a", Nothing), ("b", Nothing)]
+                userType =
+                    Type
+                        (mkName "User")
+                        ( Map.fromList
+                            [ (idKey, userIdType)
+                            , (nameKey, userNameType)
+                            , (otherPropKey, userOtherPropType)
+                            ]
+                        )
+                        []
+            describe "omit" $ do
+                it "remove fields" $ do
+                    (userWithId, logs) <- testTM (omit [nameKey, otherPropKey] userType)
+                    logs `shouldBe` []
+                    length (fields userWithId) `shouldBe` length (fields userType) - 2
+                    Map.lookup idKey (fields userWithId) `shouldNotBe` Nothing
+                    Map.lookup "otherProp" (fields userWithId) `shouldBe` Nothing
+                    Map.lookup nameKey (fields userWithId) `shouldBe` Nothing
+                describe "issue warning" $ do
+                    it "field does not exist" $ do
+                        (user2, logs) <- testTM (omit [nameKey, idKey, otherPropKey] userType)
+                        logs `shouldBe` [emptyResultType]
+                        length (fields user2) `shouldBe` 0
+                    it "field does not exist" $ do
+                        (user2, logs) <- testTM (omit [nameKey, "idonotexist"] userType)
+                        logs `shouldBe` [fieldNotInType "idonotexist"]
+                        length (fields user2) `shouldBe` length (fields userType) - 1
+                describe "fail" $ do
+                    it "has type parameters" $ do
+                        shouldFail (omit [nameKey] typeWithVar)
+
+            describe "required" $ do
+                it "mark field as required" $ do
+                    (user2, logs) <- testTM (require [otherPropKey] userType)
+                    logs `shouldBe` []
+                    snd <$> Map.lookup otherPropKey (fields user2)
+                        `shouldBe` Just userOtherPropRequiredType
+                describe "issue warning" $ do
+                    it "field does not exist" $ do
+                        (user2, logs) <- testTM (require ["idonotexist"] userType)
+                        logs `shouldBe` [fieldNotInType "idonotexist"]
+                        fields user2 `shouldBe` fields userType
+                    it "field is not optional" $ do
+                        (user2, logs) <- testTM (require [idKey] userType)
+                        logs `shouldBe` [fieldNotOptional "id"]
+                        fields user2 `shouldBe` fields userType
+
+            describe "pick" $ do
+                it "pick fields" $ do
+                    (userWithId, logs) <- testTM (pick [idKey] userType)
+                    logs `shouldBe` []
+                    length (fields userWithId) `shouldBe` 1
+                    Map.lookup idKey (fields userWithId) `shouldBe` Just userIdType
+                describe "issue warning" $ do
+                    it "field does not exist" $ do
+                        (emptyType, logs) <- testTM (pick ["a", idKey] userType)
+                        logs `shouldBe` [fieldNotInType "a"]
+                        length (fields emptyType) `shouldBe` 1
+                    it "result type is empty" $ do
+                        (emptyType, logs) <- testTM (pick [] userType)
+                        logs `shouldBe` [emptyResultType]
+                        length (fields emptyType) `shouldBe` 0
+
+                    it "field does not exist and result type is empty" $ do
+                        (emptyType, logs) <- testTM (pick ["a"] userType)
+                        logs
+                            `shouldBe` [ fieldNotInType "a"
+                                       , emptyResultType
+                                       ]
+                        length (fields emptyType) `shouldBe` 0
+                describe "fail" $ do
+                    it "has type parameters" $ do
+                        shouldFail (pick [nameKey] typeWithVar)
+
+            describe "intersection" $ do
+                it "should have only common fields" $ do
+                    (userWithId, _) <- testTM (pick [idKey] userType)
+                    (intersectionRes, logs) <- testTM (intersection userType userWithId)
+                    logs `shouldBe` []
+                    Map.toList (fields intersectionRes) `shouldBe` [(idKey, userIdType)]
+                describe "issue warning" $ do
+                    it "result type is empty" $ do
+                        (emptyType, _) <- testTM (pick [] userType)
+                        (res, logs) <- testTM (intersection emptyType userType)
+                        logs `shouldBe` [emptyResultType]
+                        length (fields res) `shouldBe` 0
+                describe "fail" $ do
+                    it "has type parameters" $ do
+                        shouldFail (intersection userType typeWithVar)
+
+            describe "union" $ do
+                it "should have all fields" $ do
+                    (userWithId, _) <- testTM (pick [idKey] userType)
+                    (unionRes, logs) <- testTM (union userType userWithId)
+                    logs `shouldBe` []
+                    fields unionRes `shouldBe` fields userType
+                it "should prefer the first type" $ do
+                    (user2, _) <- testTM (require [otherPropKey] userType)
+                    (unionRes, logs) <- testTM (union user2 userType)
+                    logs `shouldBe` []
+                    length (fields unionRes) `shouldBe` 3
+                    snd <$> Map.lookup otherPropKey (fields unionRes)
+                        `shouldBe` Just userOtherPropRequiredType
+                it "should prefer the second type" $ do
+                    (user2, _) <- testTM (require [otherPropKey] userType)
+                    (unionRes, logs) <- testTM (union' user2 userType)
+                    logs `shouldBe` []
+                    length (fields unionRes) `shouldBe` 3
+                    Map.lookup otherPropKey (fields unionRes)
+                        `shouldBe` Just userOtherPropType
+                describe "fail" $ do
+                    it "has type parameters" $ do
+                        shouldFail (union userType typeWithVar)
+
+            describe "partial" $ do
+                it "should wrap all fields with Maybe, except optional ones" $ do
+                    (partialUser, logs) <- testTM (partial userType)
+                    logs `shouldBe` []
+                    Map.lookup otherPropKey (fields partialUser)
+                        `shouldBe` Map.lookup otherPropKey (fields userType)
+                    case snd <$> Map.lookup idKey (fields partialUser) of
+                        Just (AppT (ConT wrapper) wrapped) -> do
+                            nameBase wrapper `shouldBe` "Maybe"
+                            wrapped `shouldBe` snd userIdType
+                        x -> expectationFailure ("expected a type wrapped in maybe, got " ++ show x)
+                it "should wrap all fields with Maybe, including optional ones" $ do
+                    (partialUser, logs) <- testTM (partial' userType)
+                    logs `shouldBe` []
+                    forM_ (Map.toList $ fields userType) $ \(fName, (_, fType)) ->
+                        case snd <$> Map.lookup fName (fields partialUser) of
+                            Just (AppT (ConT wrapper) wrapped) -> do
+                                nameBase wrapper `shouldBe` "Maybe"
+                                wrapped `shouldBe` fType
+                            x -> expectationFailure ("expected a type wrapped in maybe, got " ++ show x)
+
+            describe "record" $ do
+                it "should have all fields" $ do
+                    let fType = ConT (mkName "Maybe") `AppT` ConT (mkName "Int")
+                    (res, logs) <- testTM (record ["a", "b"] (return fType))
+                    logs `shouldBe` []
+                    length (fields res) `shouldBe` 2
+                    snd <$> Map.lookup "a" (fields res) `shouldBe` Just fType
+                describe "issue warning" $ do
+                    it "empty record" $ do
+                        (emptyType, logs) <- testTM (record [] (conT $ mkName "Int"))
+                        logs `shouldBe` [emptyResultType]
+                        length (fields emptyType) `shouldBe` 0
+                    it "duplicate key" $ do
+                        (res, logs) <- testTM (record ["a", "a"] (conT $ mkName "Int"))
+                        logs `shouldBe` [duplicateKey]
+                        length (fields res) `shouldBe` 1
+
+            describe "apply" $ do
+                it "should replace type variables" $ do
+                    (res, logs) <- testTM (applyMany [[t|Int|], [t|String|]] typeWithVar)
+                    typeParams res `shouldBe` []
+                    logs `shouldBe` []
+                    -- Check first type variable
+                    let aField = snd $ fromJust $ Map.lookup "a" $ fields res
+                    case aField of
+                        ConT n -> nameBase n `shouldBe` "Int"
+                        t -> expectationFailure $ "expected a type constructor, got: " ++ show t
+                    --  Check second type variable
+                    logs `shouldBe` []
+                    let bField = snd $ fromJust $ Map.lookup "b" $ fields res
+                    case bField of
+                        AppT (ConT _) (AppT (ConT _) (ConT n)) -> nameBase n `shouldBe` "String"
+                        t ->
+                            expectationFailure $
+                                "expected two nexted type constructors, got: " ++ show t
+                describe "issue warning" $ do
+                    it "no type variable" $ do
+                        (_, logs) <- testTM (apply [t|Int|] userType)
+                        logs `shouldBe` [noTypeParameter]
+  where
+    testTM = runQ . execTM
+    shouldFail tm = do
+        mres <-
+            try
+                (testTM tm) ::
+                IO (Either IOException (TypeMachine.Type, [String]))
+        mres `shouldSatisfy` isLeft
diff --git a/test/TypeMachine/IsSpec.hs b/test/TypeMachine/IsSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/TypeMachine/IsSpec.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module TypeMachine.IsSpec (spec) where
+
+import Test.Hspec
+import TypeMachine
+
+data User = User
+    { id :: Int
+    , name :: String
+    , optProp :: Maybe ()
+    }
+    deriving (Show, Eq)
+
+$(defineIs ''User)
+$(type_ "UserWithoutOptProp" (omit ["optProp"] <::> ''User))
+$(deriveIs ''User ''UserWithoutOptProp)
+
+spec :: Spec
+spec =
+    describe
+        "'Is' typeclass"
+        $ do
+            describe "get fields using typeclass" $
+                do
+                    it "original object" $ do
+                        let og = User 1 "A" (Just ())
+                        getId og `shouldBe` 1
+                        getName og `shouldBe` "A"
+                        getOptProp og `shouldBe` Just ()
+
+                    it "secondary object" $ do
+                        let og = UserWithoutOptProp 1 "A"
+                        getId og `shouldBe` 1
+                        getName og `shouldBe` "A"
+                        getOptProp og `shouldBe` Nothing
+            describe "'to' function" $
+                do
+                    let og = User 1 "A" (Just ())
+                    it "original object (identity)" $ do
+                        toUser og `shouldBe` og
+                    it "secondary object" $ do
+                        let obj = UserWithoutOptProp 1 "A"
+                        toUser obj `shouldBe` og{optProp = Nothing}
diff --git a/type-machine.cabal b/type-machine.cabal
new file mode 100644
--- /dev/null
+++ b/type-machine.cabal
@@ -0,0 +1,136 @@
+cabal-version: 2.2
+
+-- This file has been generated from package.yaml by hpack version 0.38.0.
+--
+-- see: https://github.com/sol/hpack
+
+name:           type-machine
+version:        0.1.0.0
+synopsis:       Template Haskell-based Type functions on record types in Haskell
+description:    Please see the README on GitHub at <https://github.com/Arthi-chaud/type-machine#readme>
+category:       Types
+homepage:       https://github.com/Arthi-chaud/type-machine#readme
+bug-reports:    https://github.com/Arthi-chaud/type-machine/issues
+author:         Arthi-chaud
+maintainer:     aj530@kent.ac.uk
+copyright:      2025 Arthi-chaud
+license:        BSD-3-Clause
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/Arthi-chaud/type-machine
+
+library
+  exposed-modules:
+      TypeMachine
+      TypeMachine.Functions
+      TypeMachine.Infix
+      TypeMachine.TM
+      TypeMachine.Type
+      TypeMachine.TM.Syntax
+      TypeMachine.Log
+      TypeMachine.TH
+      TypeMachine.TH.Is
+  other-modules:
+      TypeMachine.Internal.Utils
+      TypeMachine.TH.Internal.Utils
+      TypeMachine.TM.Liftable
+      Paths_type_machine
+  autogen-modules:
+      Paths_type_machine
+  hs-source-dirs:
+      src
+  default-extensions:
+      TemplateHaskell
+      LambdaCase
+      TupleSections
+      RankNTypes
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , containers
+    , mtl
+    , syb
+    , template-haskell
+  default-language: Haskell2010
+
+executable vector-example
+  main-is: examples/Vector.hs
+  other-modules:
+      Paths_type_machine
+  autogen-modules:
+      Paths_type_machine
+  default-extensions:
+      TemplateHaskell
+      LambdaCase
+      TupleSections
+      RankNTypes
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , containers
+    , syb
+    , template-haskell
+    , type-machine
+  default-language: Haskell2010
+
+test-suite type-machine-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      TypeMachine.FunctionsSpec
+      TypeMachine.IsSpec
+      Paths_type_machine
+  autogen-modules:
+      Paths_type_machine
+  hs-source-dirs:
+      test
+  default-extensions:
+      TemplateHaskell
+      LambdaCase
+      TupleSections
+      RankNTypes
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N -Wno-unused-top-binds
+  build-depends:
+      base >=4.7 && <5
+    , containers
+    , hspec
+    , syb
+    , template-haskell
+    , type-machine
+  default-language: Haskell2010
+
+benchmark bench
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  other-modules:
+      Benchmark
+      Gen
+      Paths_type_machine
+  autogen-modules:
+      Paths_type_machine
+  hs-source-dirs:
+      benchmarks/runtime
+  default-extensions:
+      TemplateHaskell
+      LambdaCase
+      TupleSections
+      RankNTypes
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-T -Wno-unused-top-binds -Wno-orphans -Wno-redundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , containers
+    , criterion
+    , extensible
+    , lens
+    , mtl
+    , superrecord
+    , syb
+    , template-haskell
+    , type-machine
+  default-language: Haskell2010