diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,8 @@
+Copyright 2017-2019 Andrew Martin
+Copyright 2017-2019 Kyle McKean
+
+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/src/Trasa/TH.hs b/src/Trasa/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Trasa/TH.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE DataKinds       #-}
+{-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE QuasiQuotes     #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wall -Werror #-}
+module Trasa.TH
+  (
+    Name
+  , CaptureRep(..)
+  , ParamRep(..)
+  , QueryRep(..)
+  , RouteRep(..)
+  , RoutesRep(..)
+  , routeDataType
+  , enumRoutesInstance
+  , metaInstance
+  , trasa
+  , parseTrasa
+  )where
+
+import           Data.Kind                 (Type)
+import qualified Data.List.NonEmpty        as NE
+import           Data.Maybe                (listToMaybe, mapMaybe)
+import           Language.Haskell.TH       hiding (Type, match)
+import qualified Language.Haskell.TH       as TH
+import           Language.Haskell.TH.Quote
+import           Trasa.Core
+import           Trasa.Core.Implicit
+
+import           Trasa.TH.Parse            (parseRoutesRep)
+import           Trasa.TH.Types
+
+genCodec :: Name -> Q CodecRep
+genCodec name = reify name >>= \case
+  VarI fullName fullType _ -> case fullType of
+    AppT codec typ -> return (CodecRep fullName codec typ)
+    _ -> fail ("Codec: " ++ show name ++ " does not have a type like (Codec Type) but has the type: " ++ show fullType)
+  _ -> fail ("Codec: " ++ show name ++ " is not a haskell value")
+
+genCodecs :: (RoutesRep CodecRep -> Q b) -> RoutesRep Name -> Q b
+genCodecs f routeRepNames = do
+  routeReps <- traverse genCodec routeRepNames
+  f routeReps
+
+typeList :: [TH.Type] -> TH.Type
+typeList = foldr (\typ rest -> PromotedConsT `AppT` typ `AppT` rest) PromotedNilT
+
+routeDataTypeCodec :: RoutesRep CodecRep -> Q Dec
+routeDataTypeCodec (RoutesRep routeStr routeReps) = do
+  kind <- [t| [Type] -> [Param] -> Bodiedness -> Type -> Type |]
+  return (DataD [] route [] (Just kind) (fmap (buildCons route) routeReps) [])
+  where
+    route = mkName routeStr
+    buildCons :: Name -> RouteRep CodecRep -> Con
+    buildCons rt (RouteRep name _ captures queries request response) = GadtC [mkName name] [] typ
+      where
+       typ =
+        ConT rt `AppT`
+        typeList (mapMaybe captureType captures) `AppT`
+        typeList (fmap (paramType . queryRepParam) queries) `AppT`
+        bodiednessType request `AppT`
+        responseType response
+    captureType :: CaptureRep CodecRep -> Maybe TH.Type
+    captureType = \case
+      MatchRep _ -> Nothing
+      CaptureRep (CodecRep _ _ typ) -> Just typ
+    paramType :: ParamRep CodecRep -> TH.Type
+    paramType = \case
+      FlagRep -> PromotedT 'Flag
+      OptionalRep (CodecRep _ _ typ) -> PromotedT 'Optional `AppT` typ
+      ListRep (CodecRep _ _ typ) -> PromotedT 'List `AppT` typ
+    bodiednessType :: [CodecRep] -> TH.Type
+    bodiednessType = \case
+      [] -> PromotedT 'Bodyless
+      (CodecRep _ _ typ:_) -> PromotedT 'Body `AppT` typ
+    responseType = \case
+      (CodecRep _ _ typ NE.:| _) -> typ
+
+routeDataType :: RoutesRep Name -> Q Dec
+routeDataType = genCodecs routeDataTypeCodec
+
+enumRoutesInstanceCodec :: RoutesRep CodecRep -> Dec
+enumRoutesInstanceCodec (RoutesRep routeStr routeReps) =
+  InstanceD Nothing [] typ [FunD 'enumerateRoutes [Clause [] (NormalB (ListE expr)) []]]
+  where
+    route = mkName routeStr
+    typ = ConT ''EnumerableRoute `AppT` ConT route
+    buildCons name = ConE 'Constructed `AppE` ConE (mkName name)
+    expr = fmap (buildCons . routeRepName) routeReps
+
+enumRoutesInstance :: RoutesRep Name -> Q Dec
+enumRoutesInstance = genCodecs (return . enumRoutesInstanceCodec)
+
+metaInstanceCodec :: RoutesRep CodecRep -> Q Dec
+metaInstanceCodec (RoutesRep routeStr routeReps) = do
+  let route = mkName routeStr
+      typ = ConT ''HasMeta `AppT` ConT route
+  capStrat <- search routeRepCaptures capCodec [t| CaptureCodec |]
+  qryStrat <- search routeRepQueries (paramCodec . queryRepParam) [t| CaptureCodec |]
+  reqBodyStrat <- search routeReqRequest (Just . codecRepCodec)  [t| BodyCodec |]
+  respBodyStrat <- search (NE.toList . routeReqResponse) (Just . codecRepCodec) [t| BodyCodec |]
+  many <- [t| Many |]
+  let mkTypeFamily str strat = TySynInstD (mkName str) (TySynEqn [ConT route] strat)
+      typeFamilies =
+        [ mkTypeFamily "CaptureStrategy" capStrat
+        , mkTypeFamily "QueryStrategy" qryStrat
+        , mkTypeFamily "RequestBodyStrategy" (many `AppT` reqBodyStrat)
+        , mkTypeFamily "ResponseBodyStrategy" (many `AppT` respBodyStrat)
+        ]
+  lam <- newName "route"
+  let metaExp = LamE [VarP lam] (CaseE (VarE lam) (fmap routeRepToMetaPattern routeReps))
+      metaFunction = FunD 'meta [Clause [] (NormalB metaExp) []]
+  return (InstanceD Nothing [] typ (typeFamilies ++ [metaFunction]))
+  where
+    search :: (RouteRep CodecRep -> [b]) -> (b -> Maybe TH.Type) -> Q TH.Type -> Q TH.Type
+    search f g err = case listToMaybe (mapMaybe g (routeReps >>= f)) of
+      Just t  -> return t
+      Nothing -> err
+    capCodec :: CaptureRep CodecRep -> Maybe TH.Type
+    capCodec = \case
+      MatchRep _ -> Nothing
+      CaptureRep (CodecRep _ codec _) -> Just codec
+    paramCodec :: ParamRep CodecRep -> Maybe TH.Type
+    paramCodec = \case
+      FlagRep -> Nothing
+      OptionalRep (CodecRep _ codec _) -> Just codec
+      ListRep (CodecRep _ codec _) -> Just codec
+    routeRepToMetaPattern :: RouteRep CodecRep -> Match
+    routeRepToMetaPattern (RouteRep name method caps qrys req res) =
+      Match (ConP (mkName name) []) (NormalB expr) []
+      where
+        expr =
+          ConE 'Meta `AppE`
+          capsE `AppE`
+          qrysE `AppE`
+          reqE `AppE`
+          respE `AppE`
+          methodE
+        capsE = foldr (\cp -> UInfixE (captureRepToExp cp) (VarE '(./))) (VarE 'end) caps
+        captureRepToExp = \case
+          MatchRep str -> VarE 'match `AppE` LitE (StringL str)
+          CaptureRep (CodecRep n _ _) -> VarE 'capture `AppE` VarE n
+        qrysE = foldr (\qp -> UInfixE (queryRepToExp qp) (VarE '(.&))) (VarE 'qend) qrys
+        queryRepToExp (QueryRep idt param) = case param of
+          FlagRep -> VarE 'flag `AppE` lit
+          OptionalRep (CodecRep n _ _) -> VarE 'optional `AppE` lit `AppE` VarE n
+          ListRep (CodecRep n _ _) -> VarE 'list `AppE` lit `AppE` VarE n
+          where lit = LitE (StringL idt)
+        reqE = case req of
+          [] -> VarE 'bodyless
+          (r : rs) -> VarE 'body `AppE` manyE (r NE.:| rs)
+        respE = VarE 'resp `AppE` manyE res
+        methodE = LitE (StringL method)
+        manyE (CodecRep n _ _ NE.:| xs) =
+          ConE 'Many `AppE` (UInfixE (VarE n) (ConE '(NE.:|)) (ListE (VarE . codecRepName <$> xs)))
+
+metaInstance :: RoutesRep Name -> Q Dec
+metaInstance = genCodecs metaInstanceCodec
+
+trasa :: RoutesRep Name -> Q [Dec]
+trasa routeRepNames = do
+  routeReps <- traverse genCodec routeRepNames
+  rt <- routeDataTypeCodec routeReps
+  let cons = enumRoutesInstanceCodec routeReps
+  m <- metaInstanceCodec routeReps
+  return [rt, cons, m]
+
+parseTrasa :: QuasiQuoter
+parseTrasa = QuasiQuoter err err err quoter
+  where
+    err _ = fail "parseTrasa: This quasi quoter should only be used on the top level"
+    quoter :: String -> Q [Dec]
+    quoter str = case parseRoutesRep str of
+      Left e              -> fail e
+      Right routeRepNames -> trasa routeRepNames
diff --git a/src/Trasa/TH/Lexer.hs b/src/Trasa/TH/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/src/Trasa/TH/Lexer.hs
@@ -0,0 +1,220 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Trasa.TH.Lexer
+  ( ReservedChar(..)
+  , ReservedSymbol(..)
+  , Lexeme(..)
+  , Stream(..)
+  , stream ) where
+
+import Data.Proxy (Proxy(..))
+import Data.Semigroup ((<>))
+import Data.Void (Void)
+import Data.Coerce
+import qualified Data.List.NonEmpty as NE
+import qualified Data.List as L
+import qualified Text.Megaparsec as MP
+import qualified Text.Megaparsec.Char as MP
+import qualified Text.Megaparsec.Stream as MP
+
+type Parser a = MP.Parsec Void String a
+
+instance Ord a => MP.ShowErrorComponent (MP.ErrorFancy a) where
+  showErrorComponent (MP.ErrorFail e) = e
+  showErrorComponent (MP.ErrorCustom _) = "undefined error"
+
+data ReservedChar
+  = ReservedCharNewline
+  | ReservedCharColon
+  | ReservedCharSlash
+  | ReservedCharQuestionMark
+  | ReservedCharAmpersand
+  | ReservedCharEqual
+  | ReservedCharOpenBracket
+  | ReservedCharCloseBracket
+  | ReservedCharComma
+  | ReservedCharTab
+  deriving (Show,Eq,Ord)
+
+data ReservedSymbol
+  = ReservedSymbolDataType
+  deriving (Show,Eq,Ord)
+
+data Lexeme
+  = LexemeSpace Word
+  | LexemeChar ReservedChar
+  | LexemeSymbol ReservedSymbol
+  | LexemeString Word String
+  deriving (Show,Eq,Ord)
+
+newtype Stream = Stream [Lexeme] 
+  deriving (Eq, Ord, Show, Monoid, Semigroup)
+
+instance MP.Stream Stream where
+  type Token Stream = Lexeme
+  type Tokens Stream = [Lexeme]
+  tokenToChunk Proxy = pure
+  tokensToChunk Proxy = id
+  chunkToTokens Proxy = id
+  chunkLength Proxy = length
+  chunkEmpty Proxy = null
+  take1_ (Stream []) = Nothing
+  take1_ (Stream (t:ts)) = Just (t, Stream ts)
+  takeN_ n (Stream s)
+    | n <= 0    = Just ([], Stream s)
+    | null s    = Nothing
+    | otherwise = Just $ coerce (splitAt n s)
+  takeWhile_ = coerce . span
+  -- NOTE Do not eta-reduce these (breaks inlining)
+  reachOffset o pst = reachOffset' (\n (Stream l) -> coerce $ splitAt n l) L.foldl' (fmap prettyCharToken . coerce) (prettyCharToken . coerce) (coerce $ LexemeChar ReservedCharNewline, coerce $ LexemeChar ReservedCharTab) o (coerce pst)
+  showTokens _ = L.concatMap prettyToken . NE.toList
+
+prettyCharToken = \case
+  LexemeSpace _ -> ' '
+  LexemeChar resChar -> case resChar of
+    ReservedCharNewline -> '\n'
+    ReservedCharColon -> ':'
+    ReservedCharSlash -> '/'
+    ReservedCharQuestionMark -> '?'
+    ReservedCharAmpersand -> '&'
+    ReservedCharEqual -> '='
+    ReservedCharOpenBracket -> '['
+    ReservedCharCloseBracket -> ']'
+    ReservedCharComma -> ','
+    ReservedCharTab -> '\t'
+  LexemeSymbol sym -> case sym of
+    ReservedSymbolDataType -> 'd'
+  LexemeString _ _ -> 's'
+
+prettyToken = \case
+  LexemeSpace _ -> "space(s)"
+  LexemeChar resChar -> case resChar of
+    ReservedCharNewline -> "newline"
+    ReservedCharColon -> ":"
+    ReservedCharSlash -> "/"
+    ReservedCharQuestionMark -> "?"
+    ReservedCharAmpersand -> "&"
+    ReservedCharEqual -> "="
+    ReservedCharOpenBracket -> "["
+    ReservedCharCloseBracket -> "]"
+    ReservedCharComma -> ","
+    ReservedCharTab -> "tab"
+  LexemeSymbol sym -> case sym of
+    ReservedSymbolDataType -> "data-type"
+  LexemeString _ _ -> "any string"
+
+lexeme :: Parser Lexeme
+lexeme = MP.choice
+  [ LexemeSpace . fromIntegral . length <$> MP.some (MP.char ' ')
+  , LexemeChar <$> MP.choice
+    [ ReservedCharNewline <$ MP.char '\n'
+    , ReservedCharColon <$ MP.char ':'
+    , ReservedCharSlash <$ MP.char '/'
+    , ReservedCharQuestionMark <$ MP.char '?'
+    , ReservedCharAmpersand <$ MP.char '&'
+    , ReservedCharEqual <$ MP.char '='
+    , ReservedCharOpenBracket <$ MP.char '['
+    , ReservedCharCloseBracket <$ MP.char ']'
+    , ReservedCharComma <$ MP.char ','
+    ]
+  , LexemeSymbol <$> MP.choice
+    [ ReservedSymbolDataType <$ MP.string "data-type"
+    ]
+  , string <$> MP.some (MP.noneOf " \n:/?&=[],")
+  ]
+  where string str = LexemeString (fromIntegral (length str)) str
+
+data St = St MP.SourcePos ShowS
+
+reachOffset'
+  :: (Int -> Stream -> (MP.Tokens Stream, Stream))
+     -- ^ How to split input stream at given offset
+  -> (forall b. (b -> MP.Token Stream -> b) -> b -> MP.Tokens Stream -> b)
+     -- ^ How to fold over input stream
+  -> (MP.Tokens Stream -> String)
+     -- ^ How to convert chunk of input stream into a 'String'
+  -> (MP.Token Stream -> Char)
+     -- ^ How to convert a token into a 'Char'
+  -> (MP.Token Stream, MP.Token Stream)
+     -- ^ Newline token and tab token
+  -> Int
+     -- ^ Offset to reach
+  -> MP.PosState Stream
+     -- ^ Initial 'MP.PosState' to use
+  -> (MP.SourcePos, String, MP.PosState Stream)
+     -- ^ Reached 'SourcePos', line at which 'SourcePos' is located, updated
+     -- 'MP.PosState'
+reachOffset' splitAt'
+             foldl''
+             fromToks
+             fromTok
+             (newlineTok, tabTok)
+             o
+             MP.PosState {..} =
+  ( spos
+  , case expandTab pstateTabWidth
+           . addPrefix
+           . f
+           . fromToks
+           . fst
+           $ MP.takeWhile_ (/= newlineTok) post of
+      "" -> "<empty line>"
+      xs -> xs
+  , MP.PosState
+      { MP.pstateInput = post
+      , MP.pstateOffset = max pstateOffset o
+      , MP.pstateSourcePos = spos
+      , MP.pstateTabWidth = pstateTabWidth
+      , MP.pstateLinePrefix =
+          if sameLine
+            -- NOTE We don't use difference lists here because it's
+            -- desirable for 'MP.PosState' to be an instance of 'Eq' and
+            -- 'Show'. So we just do appending here. Fortunately several
+            -- parse errors on the same line should be relatively rare.
+            then pstateLinePrefix ++ f ""
+            else f ""
+      }
+  )
+  where
+    addPrefix xs =
+      if sameLine
+        then pstateLinePrefix ++ xs
+        else xs
+    sameLine = MP.sourceLine spos == MP.sourceLine pstateSourcePos
+    (pre, post) = splitAt' (o - pstateOffset) pstateInput
+    St spos f = foldl'' go (St pstateSourcePos id) pre
+    go (St apos g) ch =
+      let MP.SourcePos n l c = apos
+          c' = MP.unPos c
+          w  = MP.unPos pstateTabWidth
+      in if | ch == newlineTok ->
+                St (MP.SourcePos n (l <> MP.pos1) MP.pos1)
+                   id
+            | ch == tabTok ->
+                St (MP.SourcePos n l (MP.mkPos $ c' + w - ((c' - 1) `rem` w)))
+                   (g . (fromTok ch :))
+            | otherwise ->
+                St (MP.SourcePos n l (c <> MP.pos1))
+                   (g . (fromTok ch :))
+{-# INLINE reachOffset' #-}
+
+expandTab
+  :: MP.Pos
+  -> String
+  -> String
+expandTab w' = go 0
+  where
+    go 0 []        = []
+    go 0 ('\t':xs) = go w xs
+    go 0 (x:xs)    = x : go 0 xs
+    go n xs        = ' ' : go (n - 1) xs
+    w              = MP.unPos w'
+
+stream :: Parser Stream
+stream = Stream <$> MP.many lexeme
diff --git a/src/Trasa/TH/Parse.hs b/src/Trasa/TH/Parse.hs
new file mode 100644
--- /dev/null
+++ b/src/Trasa/TH/Parse.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE LambdaCase #-}
+module Trasa.TH.Parse where
+
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Set as S
+import Data.Bifunctor (first)
+import Language.Haskell.TH (Name,mkName)
+import Control.Applicative ((<|>))
+import Control.Monad (void)
+import Data.Void (Void)
+import qualified Text.Megaparsec as MP
+import qualified Text.Megaparsec.Char.Lexer as L
+
+import Trasa.TH.Types
+import Trasa.TH.Lexer
+
+import Debug.Trace
+
+type Parser = MP.Parsec (MP.ErrorFancy Void) Stream
+
+wrongToken :: a -> S.Set (MP.ErrorItem a)
+wrongToken t = S.singleton (MP.Tokens (t NE.:| []))
+
+space :: Parser ()
+space = flip MP.token (wrongToken $ LexemeSpace 0) $ \case
+  LexemeSpace _ -> Just ()
+  other -> Nothing
+
+optionalSpace :: Parser ()
+optionalSpace = void (MP.optional space)
+
+string :: Parser String
+string = flip MP.token (wrongToken (LexemeString 0 "")) $ \case
+  LexemeString _ str -> Just str
+  other -> Nothing
+
+name :: Parser Name
+name = fmap mkName string
+
+match :: Lexeme -> Parser ()
+match lexeme = flip MP.token (wrongToken lexeme) $ \other -> 
+  if lexeme == other
+  then Just ()
+  else Nothing
+
+matchChar :: ReservedChar -> Parser ()
+matchChar = match . LexemeChar
+
+newline :: Parser ()
+newline = matchChar ReservedCharNewline
+
+colon :: Parser ()
+colon = matchChar ReservedCharColon
+
+slash :: Parser ()
+slash = matchChar ReservedCharSlash
+
+questionMark :: Parser ()
+questionMark = matchChar ReservedCharQuestionMark
+
+ampersand :: Parser ()
+ampersand = matchChar ReservedCharAmpersand
+
+equal :: Parser ()
+equal = matchChar ReservedCharEqual
+
+bracket :: Parser a -> Parser a
+bracket = MP.between (matchChar ReservedCharOpenBracket) (matchChar ReservedCharCloseBracket)
+
+comma :: Parser ()
+comma = matchChar ReservedCharComma
+
+capture :: Parser (CaptureRep Name)
+capture =
+  fmap MatchRep string <|>
+  fmap CaptureRep (colon *> name)
+
+query :: Parser [QueryRep Name]
+query = MP.sepBy (QueryRep <$> string <*> paramRep) ampersand
+  where
+    paramRep = MP.choice [ fmap OptionalRep optional, fmap ListRep list, pure FlagRep ]
+    optional = MP.try (equal *> name)
+    list = equal *> bracket name
+
+list :: Parser a -> Parser [a]
+list val = bracket (MP.sepBy val (optionalSpace *> comma <* optionalSpace))
+
+response :: Parser (NE.NonEmpty Name)
+response = list name >>= \case
+  [] -> fail "Response requires at least one response type in the list"
+  (n : ns) -> pure (n NE.:| ns)
+
+routeRep :: Parser (RouteRep Name)
+routeRep = do
+  optionalSpace
+  routeId <- string
+  space
+  method <- string
+  space
+  slash
+  caps <- MP.sepBy capture slash
+  qrys <- questionMark *> query <|> return []
+  space
+  req  <- list name
+  space
+  res  <- response
+  optionalSpace
+  newline
+  return (RouteRep routeId method caps qrys req res)
+
+routesRep :: Parser (RoutesRep Name)
+routesRep = do
+  optionalSpace
+  void (MP.optional newline)
+  optionalSpace
+  match (LexemeSymbol ReservedSymbolDataType)
+  colon
+  optionalSpace
+  dataType <- string
+  newline
+  routes <- MP.many routeRep
+  return (RoutesRep dataType routes)
+
+parseRoutesRep :: String -> Either String (RoutesRep Name)
+parseRoutesRep str = do
+  tokens <- first MP.errorBundlePretty (MP.parse stream "" str)
+  first MP.errorBundlePretty (MP.parse routesRep "" (traceShowId tokens))
diff --git a/src/Trasa/TH/Types.hs b/src/Trasa/TH/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Trasa/TH/Types.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE DeriveTraversable #-}
+module Trasa.TH.Types where
+
+import qualified Data.List.NonEmpty as NE
+import Language.Haskell.TH
+
+data CodecRep = CodecRep
+  { codecRepName :: Name
+  , codecRepCodec :: Type
+  , codecRepType :: Type
+  } deriving Show
+
+data CaptureRep codecRep
+  = MatchRep String
+  | CaptureRep codecRep
+  deriving (Show,Foldable,Functor,Traversable)
+
+data ParamRep codecRep
+  = FlagRep
+  | OptionalRep codecRep
+  | ListRep codecRep
+  deriving (Show,Foldable,Functor,Traversable)
+
+data QueryRep codecRep = QueryRep
+  { queryRepKey :: String
+  , queryRepParam :: ParamRep codecRep
+  } deriving (Show,Foldable,Functor,Traversable)
+
+data RouteRep codecRep = RouteRep
+  { routeRepName :: String
+  , routeRepMethod :: String
+  , routeRepCaptures :: [CaptureRep codecRep]
+  , routeRepQueries :: [QueryRep codecRep]
+  , routeReqRequest :: [codecRep]
+  , routeReqResponse :: NE.NonEmpty codecRep
+  } deriving (Show,Foldable,Functor,Traversable)
+
+data RoutesRep codecRep = RoutesRep
+  { routesRepName :: String
+  , routesRepRoutes :: [RouteRep codecRep]
+  } deriving (Show,Foldable,Functor,Traversable)
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wall -Werror -ddump-splices #-}
+module Main where
+
+import Data.List.NonEmpty
+import Trasa.Core
+import Trasa.Core.Implicit
+import Trasa.TH
+
+int :: CaptureEncoding Int
+int = captureCodecToCaptureEncoding showReadCaptureCodec
+
+bodyInt :: BodyCodec Int
+bodyInt = showReadBodyCodec
+
+bodyString :: BodyCodec String
+bodyString = showReadBodyCodec
+
+bodyUnit :: BodyCodec ()
+bodyUnit = showReadBodyCodec
+
+$(trasa (
+  RoutesRep
+  "Route"
+  [ RouteRep
+      "Add"
+      "GET"
+      [MatchRep "add",CaptureRep 'int, CaptureRep 'int]
+      [QueryRep "third" (OptionalRep 'int)]
+      []
+      ('bodyInt :| [])
+  , RouteRep
+      "Blog"
+      "POST"
+      [MatchRep "blog"]
+      [QueryRep "id" (ListRep 'int)]
+      ['bodyString]
+      ('bodyUnit :| [])
+  ]))
+
+
+[parseTrasa|
+data-type: ParsedRoute
+ParsedAdd GET /add/:int/:int?third=int [] [bodyInt]
+ParsedBlog POST /?id=int [bodyString] [bodyUnit]
+|]
+
+main :: IO ()
+main = do
+  print (link (prepare Add 1 1 (Just 1)))
+  print (link (prepare Blog [1,2,3] "This is a post"))
diff --git a/trasa-th.cabal b/trasa-th.cabal
new file mode 100644
--- /dev/null
+++ b/trasa-th.cabal
@@ -0,0 +1,64 @@
+cabal-version: 2.2
+name:
+  trasa-th
+version:
+  0.4
+synopsis:
+  Template Haskell to generate trasa routes
+description:
+  Trasa routes can sometimes be tedious to write out by hand, so `trasa-th`
+  offers some `-XTemplateHaskell`-based help to generate your `Route`
+  GADT.
+homepage:
+  https://github.com/haskell-trasa/trasa
+author:
+  Andrew Martin
+  Kyle McKean
+maintainer:
+  Andrew Martin <andrew.thaddeus@gmail.com>
+  Kyle McKean <mckean.kylej@gmail.com>
+  chessai <chessai1996@gmail.com>
+license:
+  MIT
+license-file:
+  LICENSE
+copyright:
+  © 2017-2019 Andrew Martin
+  © 2017-2019 Kyle McKean
+category:
+  Web
+build-type:
+  Simple
+
+library
+  hs-source-dirs:
+    src
+  exposed-modules:
+    Trasa.TH
+    Trasa.TH.Lexer
+    Trasa.TH.Parse
+    Trasa.TH.Types
+  build-depends:
+    , base >=4.9 && < 5.0
+    , template-haskell >= 2.12 && < 2.15
+    , containers >= 0.5 && < 0.7
+    , megaparsec == 7.*
+    , trasa == 0.4
+  default-language:
+    Haskell2010
+
+test-suite test
+ type:
+   exitcode-stdio-1.0
+ hs-source-dirs:
+   test
+ main-is:
+   Main.hs
+ build-depends:
+   , base
+   , trasa
+   , trasa-th
+ ghc-options:
+   -threaded -rtsopts -with-rtsopts=-N
+ default-language:
+   Haskell2010