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/demo/Main.hs b/demo/Main.hs
new file mode 100644
--- /dev/null
+++ b/demo/Main.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE
+  QuasiQuotes, TemplateHaskell,
+  FlexibleInstances, MultiParamTypeClasses,
+  DataKinds, TypeFamilies,
+  UndecidableInstances
+  #-}
+module Main
+where
+
+import Prelude
+import Domain
+import DomainOptics
+import Optics
+
+
+main =
+  return ()
+
+declare Nothing labelOpticDeriver
+  [schema|
+
+    ServiceAddress:
+      sum:
+        network: NetworkAddress
+        local: FilePath
+
+    NetworkAddress:
+      product:
+        protocol: TransportProtocol
+        host: Host
+        port: Word16
+
+    TransportProtocol:
+      enum:
+        - tcp
+        - udp
+
+    Host:
+      sum:
+        ip: Ip
+        name: Text
+
+    Ip:
+      sum:
+        v4: Word32
+        v6: Word128
+
+    Word128:
+      product:
+        part1: Word64
+        part2: Word64
+
+    |]
diff --git a/domain-optics.cabal b/domain-optics.cabal
new file mode 100644
--- /dev/null
+++ b/domain-optics.cabal
@@ -0,0 +1,47 @@
+name: domain-optics
+version: 0.1
+synopsis: Integration of domain with optics
+homepage: https://github.com/nikita-volkov/domain-optics
+bug-reports: https://github.com/nikita-volkov/domain-optics/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/domain-optics.git
+
+library
+  hs-source-dirs: library
+  default-extensions: BangPatterns, BlockArguments, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DerivingVia, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedLabels, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples
+  default-language: Haskell2010
+  exposed-modules:
+    DomainOptics
+  other-modules:
+    DomainOptics.InstanceDecs
+    DomainOptics.Prelude
+    DomainOptics.Util.OpticsTH
+  build-depends:
+    base >=4.12 && <5,
+    domain-core >=0.1 && <0.2,
+    optics-core >=0.3.0.1 && <0.4,
+    text >=1 && <2,
+    template-haskell >=2.14 && <3,
+    template-haskell-compat-v0208 >=0.1.5 && <0.2,
+    th-lego >=0.2.1 && <0.3,
+    unordered-containers >=0.2.10 && <0.3
+
+test-suite demo
+  type: exitcode-stdio-1.0
+  hs-source-dirs: demo
+  main-is: Main.hs
+  default-language: Haskell2010
+  build-depends:
+    domain,
+    domain-optics,
+    optics,
+    rerebase >=1.9 && <2
diff --git a/library/DomainOptics.hs b/library/DomainOptics.hs
new file mode 100644
--- /dev/null
+++ b/library/DomainOptics.hs
@@ -0,0 +1,16 @@
+module DomainOptics
+where
+
+import DomainOptics.Prelude
+import qualified DomainCore.Deriver as Deriver
+import qualified DomainOptics.InstanceDecs as InstanceDecs
+
+
+{-|
+Generates 'LabelOptic' instances for enums, products and sums,
+automatically choosing the appropriate optic type.
+
+Requires to have the @UndecidableInstances@ extension enabled.
+-}
+labelOpticDeriver =
+  Deriver.effectless InstanceDecs.labelOptic
diff --git a/library/DomainOptics/InstanceDecs.hs b/library/DomainOptics/InstanceDecs.hs
new file mode 100644
--- /dev/null
+++ b/library/DomainOptics/InstanceDecs.hs
@@ -0,0 +1,37 @@
+module DomainOptics.InstanceDecs
+where
+
+import DomainOptics.Prelude
+import Language.Haskell.TH.Syntax
+import THLego.Helpers
+import qualified DomainOptics.Util.OpticsTH as OpticsTH
+import qualified DomainCore.Model as Model
+import qualified DomainCore.TH as DomainTH
+
+
+-- *
+-------------------------
+
+labelOptic (Model.TypeDec typeName typeDef) =
+  case typeDef of
+    Model.ProductTypeDef members ->
+      zipWith zipper (enumFrom 0) members
+      where
+        membersLength =
+          length members
+        zipper fieldIndex (fieldName, fieldType) =
+          OpticsTH.fieldLensLabelOpticInstanceDec
+            (textTyLit fieldName)
+            (textName typeName)
+            (DomainTH.typeType fieldType)
+            membersLength
+            fieldIndex
+    Model.SumTypeDef structure ->
+      fmap mapper structure
+      where
+        mapper (memberName, subTypes) =
+          OpticsTH.prismLabelOpticInstanceDec
+            (textTyLit memberName)
+            (textName typeName)
+            (DomainTH.sumConstructorName typeName memberName)
+            (fmap DomainTH.typeType subTypes)
diff --git a/library/DomainOptics/Prelude.hs b/library/DomainOptics/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/library/DomainOptics/Prelude.hs
@@ -0,0 +1,84 @@
+module DomainOptics.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 hiding ((%))
+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 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, ReadS, 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/library/DomainOptics/Util/OpticsTH.hs b/library/DomainOptics/Util/OpticsTH.hs
new file mode 100644
--- /dev/null
+++ b/library/DomainOptics/Util/OpticsTH.hs
@@ -0,0 +1,142 @@
+{-|
+TH utils for optics.
+-}
+module DomainOptics.Util.OpticsTH
+where
+
+import DomainOptics.Prelude
+import Language.Haskell.TH
+import THLego.Helpers
+import qualified THLego.Lambdas as Lambdas
+import qualified Optics.Core as Optics
+import qualified Data.Text as Text
+
+
+-- * Optics
+-------------------------
+
+productLensVlE :: Name -> Int -> Int -> Exp
+productLensVlE conName numMembers index =
+  AppE (VarE 'Optics.lensVL) (Lambdas.vlLens conName numMembers index)
+
+productLensE :: Name -> Int -> Int -> Exp
+productLensE conName numMembers index =
+  AppE (AppE (VarE 'Optics.lens) getterE) setterE
+  where
+    getterE =
+      Lambdas.productGetter conName numMembers index
+    setterE = 
+      Lambdas.productSetter conName numMembers index
+
+{-|
+>prism' Dog (\ case
+>  Dog a -> Just a
+>  _ -> Nothing)
+-}
+singleMemberPrismE :: Name -> Exp
+singleMemberPrismE conName =
+  AppE (AppE (VarE 'Optics.prism') (ConE conName))
+    (LamE [VarP aName] (CaseE (VarE aName) [
+      Match (ConP conName [VarP bName]) (NormalB (AppE (ConE 'Just) (VarE bName))) []
+      ,
+      Match WildP (NormalB (ConE 'Nothing)) []
+      ]))
+
+{-|
+Prism to a tuple of members.
+-}
+prismE :: Name -> Int -> Exp
+prismE conName numMembers =
+  multiAppE (VarE 'Optics.prism') [
+    Lambdas.tupleOrSingletonToProduct conName numMembers
+    ,
+    Lambdas.adtConstructorNarrower conName numMembers
+    ]
+
+emptyConLensE :: Name -> Exp
+emptyConLensE conName =
+  AppE (AppE (VarE 'Optics.lens) getterE) setterE
+  where
+    getterE =
+      LamE [VarP aName] (CaseE (VarE aName) [
+        Match (ConP conName []) (NormalB (ConE 'True)) []
+        ,
+        Match WildP (NormalB (ConE 'False)) []
+        ])
+    setterE =
+      LamE [VarP aName, VarP bName] (CondE (VarE bName) (ConE conName) (VarE aName))
+
+namedFieldLensE :: Name -> Exp
+namedFieldLensE fieldName =
+  AppE (AppE (VarE 'Optics.lens) getterE) setterE
+  where
+    getterE =
+      VarE fieldName
+    setterE = 
+      Lambdas.namedFieldSetter fieldName
+
+
+-- * LabelOptic instances
+-------------------------
+
+{-|
+General definition helper.
+-}
+labelOpticInstanceD :: TyLit -> Name -> Name -> Type -> Exp -> Dec
+labelOpticInstanceD lit opticType typeName aAndBType exp =
+  InstanceD Nothing cxt headType [labelOpticDec]
+  where
+    cxt =
+      [aPred, bPred, cPred]
+      where
+        aPred =
+          eqConstraintT aName aAndBType
+        bPred =
+          eqConstraintT bName aAndBType
+        cPred =
+          eqConstraintT cName (ConT opticType)
+    headType =
+      foldl' AppT (ConT ''Optics.LabelOptic) [
+        LitT lit,
+        VarT cName,
+        ConT typeName,
+        ConT typeName,
+        VarT aName,
+        VarT bName
+        ]
+    labelOpticDec =
+      FunD 'Optics.labelOptic [Clause [] (NormalB exp) []]
+
+{-|
+>instance (k ~ A_Lens, a ~ String, b ~ String) => LabelOptic "name" k Human Human a b where
+>  labelOptic = lensVL $ \f s -> (\v -> s { humanName = v }) <$> f (humanName s)
+-}
+fieldLensLabelOpticInstanceDec :: TyLit -> Name -> Type -> Int -> Int -> Dec
+fieldLensLabelOpticInstanceDec lit typeName aAndBType numMembers index =
+  labelOpticInstanceD lit ''Optics.A_Lens typeName aAndBType
+    (productLensVlE typeName numMembers index)
+
+{-|
+>instance (k ~ A_Prism, a ~ String, b ~ String) => LabelOptic "dog" k Pet Pet a b where
+>  labelOptic =
+>    prism' Dog (\ case
+>      Dog a -> Just a
+>      _ -> Nothing)
+-}
+prismLabelOpticInstanceDec :: TyLit -> Name -> Name -> [Type] -> Dec
+prismLabelOpticInstanceDec lit typeName conName memberTypes =
+  labelOpticInstanceD lit ''Optics.A_Prism typeName aAndBType exp
+  where
+    aAndBType =
+      appliedTupleOrSingletonT memberTypes
+    exp =
+      prismE conName (length memberTypes)
+
+emptyConLensLabelOpticInstanceDec :: TyLit -> Name -> Name -> Dec
+emptyConLensLabelOpticInstanceDec lit typeName conName =
+  labelOpticInstanceD lit ''Optics.A_Lens typeName aAndBType exp
+  where
+    aAndBType =
+      ConT ''Bool
+    exp =
+      emptyConLensE conName