diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,4 @@
+0.4 (2021-XX-XX)
+================
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
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/pinch-gen.cabal b/pinch-gen.cabal
new file mode 100644
--- /dev/null
+++ b/pinch-gen.cabal
@@ -0,0 +1,37 @@
+cabal-version:       >=1.10
+
+name:                pinch-gen
+version:             0.4.0.0
+-- synopsis:
+synopsis:            A code generator for the pinch Thrift library.
+homepage:            https://github.com/phile314/pinch-gen
+bug-reports:         https://github.com/phile314/pinch-gen/issues
+license:             BSD3
+license-file:        LICENSE
+author:              Tiko Energy Systems (Philipp Hausmann)
+maintainer:          philipp.hausmann@tiko.energy
+category:            Development
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+
+executable pinch-gen
+  main-is:             Main.hs
+  hs-source-dirs:      src
+  other-modules:       Pinch.Generate
+                     , Pinch.Generate.Pretty
+  build-depends:       base >=4.12 && < 4.16
+                     , bytestring
+                     , directory
+                     , filepath
+                     , language-thrift >= 0.12.0.0
+                     , megaparsec
+                     , mtl
+                     , optparse-applicative
+                     , prettyprinter
+                     , text
+                     , unordered-containers
+  default-language:    Haskell2010
+
+source-repository head
+  type: git
+  location: https://github.com/phile314/pinch-gen
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,41 @@
+module Main where
+
+
+import Options.Applicative
+
+import Pinch.Generate
+
+import Data.Text       as T
+import System.FilePath
+
+data Options = Options
+  { inputFile   :: FilePath
+  , outputDir   :: FilePath
+  , genSettings :: Settings
+  }
+  deriving (Show)
+
+
+pOptions :: Parser Options
+pOptions = Options
+  <$> strOption (long "in" <> metavar "IN_FILE" <> help "Thrift input file")
+  <*> strOption (long "out" <> metavar "OUT_DIR" <> help "Output folder")
+  <*> pGenSettings
+
+pGenSettings :: Parser Settings
+pGenSettings = Settings
+  <$> strOption (long "hashable-vec-mod" <> help "Module containing hashable instances for vector")
+  <*> flag True False (long "no-generate-arbitrary")
+  <*> many (strOption (long "extra-import" <> metavar "IMPORT"))
+
+main :: IO ()
+main = do
+  opts <- execParser pOpts
+
+  generate (genSettings opts) (inputFile opts) (outputDir opts)
+
+  where
+    pOpts = info (pOptions <**> helper)
+      ( fullDesc
+      <> progDesc "Generate Haskell files from a thrift input file."
+      <> header "Thrift Haskell Code Generator")
diff --git a/src/Pinch/Generate.hs b/src/Pinch/Generate.hs
new file mode 100644
--- /dev/null
+++ b/src/Pinch/Generate.hs
@@ -0,0 +1,512 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Pinch.Generate where
+
+import           Control.Applicative
+import           Control.Exception
+import           Control.Monad.Reader
+import qualified Data.ByteString                       as BS
+import           Data.Char
+import qualified Data.HashMap.Strict                   as Map
+import           Data.List
+import           Data.Maybe
+import qualified Data.Text                             as T
+import           Data.Text.Encoding
+import           Data.Text.Prettyprint.Doc
+import           Data.Text.Prettyprint.Doc.Render.Text
+import           Data.Void
+import           Language.Thrift.AST                   as A
+import           Language.Thrift.Parser
+import qualified Pinch.Generate.Pretty                 as H
+import           System.Directory
+import           System.FilePath
+import           System.IO
+import           Text.Megaparsec                       (SourcePos)
+import qualified Text.Megaparsec                       as P
+import qualified Text.Megaparsec.Error                 as E
+import qualified Text.Megaparsec.Pos                   as Pos
+
+data Settings
+  = Settings
+  { sHashableVectorInstanceModule :: T.Text
+  , sGenerateArbitrary            :: Bool
+  , sExtraImports                 :: [T.Text]
+  } deriving (Show)
+
+generate :: Settings -> FilePath -> FilePath -> IO ()
+generate s inp out = do
+  thrift <- loadFile inp
+
+  mods <- gProgram s inp thrift
+
+
+
+  forM_ mods $ \mod -> do
+    let targetFile = out </> moduleFile mod
+    createDirectoryIfMissing True (dropFileName targetFile)
+    withFile targetFile WriteMode (\h -> hPutDoc h $ pretty mod)
+
+moduleFile :: H.Module -> FilePath
+moduleFile m =
+  (foldr (</>) "" parts) <.> "hs"
+  where
+    (H.ModuleName n) = H.modName m
+    parts = map T.unpack $ T.splitOn "." n
+
+extractModuleName :: FilePath -> T.Text
+extractModuleName f = mconcat $ map capitalize parts
+  where
+    fileName = dropExtension $ takeFileName f
+    parts = T.splitOn "_" $ T.pack fileName
+
+extractNamespace :: [Header SourcePos] -> Maybe T.Text
+extractNamespace headers =
+  listToMaybe $ mapMaybe (\x -> case x of
+    HeaderNamespace (Namespace l n _) | l == "hs" || l == "*" -> Just (n <> ".")
+    _ -> Nothing
+  ) headers
+
+
+loadFile :: FilePath -> IO (Program SourcePos)
+loadFile inp = do
+  thrift <- parseFromFile' inp
+  case thrift of
+    Left err -> do
+      putStrLn "Could not parse thrift file."
+      throwIO $ err
+    Right s -> pure s
+
+parseFromFile' :: FilePath -> IO (Either (E.ParseErrorBundle T.Text Void) (Program SourcePos))
+parseFromFile' path = P.runParser thriftIDL path . decodeUtf8 <$> BS.readFile path
+
+
+
+gProgram :: Settings -> FilePath -> Program SourcePos -> IO [H.Module]
+gProgram s inp (Program headers defs) = do
+  (imports, tyMaps) <- unzip <$> traverse (gInclude baseDir) incHeaders
+
+  let tyMap = Map.unions tyMaps
+  let (typeDecls, clientDecls, serverDecls) = unzip3 $ runReader (traverse gDefinition defs) $ Context tyMap s
+  let mkMod suffix = H.Module (H.ModuleName $ modBaseName <> suffix)
+        [ H.PragmaLanguage "TypeFamilies, DeriveGeneric, TypeApplications"
+        , H.PragmaOptsGhc "-fno-warn-unused-imports -fno-warn-name-shadowing -fno-warn-unused-matches" ]
+  pure $
+    [ -- types
+      mkMod ".Types"
+      (imports ++ defaultImports ++ map
+        (\n -> H.ImportDecl (H.ModuleName n) True H.IEverything)
+        (sExtraImports s ++ if sGenerateArbitrary s then [ "Test.QuickCheck" ] else [])
+      )
+      (concat typeDecls)
+    , -- client
+      mkMod ".Client"
+      ( [ impTypes
+        , H.ImportDecl (H.ModuleName "Pinch.Client") True H.IEverything
+        ] ++ imports ++ defaultImports)
+      (concat clientDecls)
+    , -- server
+      mkMod ".Server"
+      ( [ impTypes
+        , H.ImportDecl (H.ModuleName "Pinch.Server") True H.IEverything
+        ] ++ imports ++ defaultImports)
+      (concat serverDecls)
+    ]
+
+  where
+    ns = fromMaybe "" $ extractNamespace headers
+    modBaseName = ns <> extractModuleName inp
+    baseDir = dropFileName inp
+    incHeaders = mapMaybe (\x -> case x of
+      HeaderInclude i -> Just i
+      _ -> Nothing)
+      headers
+    impTypes = H.ImportDecl (H.ModuleName $ modBaseName <> ".Types") False H.IEverything
+    defaultImports =
+      [ H.ImportDecl (H.ModuleName "Prelude") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Control.Applicative") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Control.Exception") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Pinch") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Pinch.Server") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Pinch.Internal.RPC") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Data.Text") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Data.ByteString") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Data.Int") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Data.Vector") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Data.HashMap.Strict") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Data.HashSet") True H.IEverything
+      , H.ImportDecl (H.ModuleName "GHC.Generics") True H.IEverything
+      , H.ImportDecl (H.ModuleName "Data.Hashable") True H.IEverything
+      , H.ImportDecl (H.ModuleName $ sHashableVectorInstanceModule s) False (H.IJust [])
+      ]
+
+type ModuleMap = Map.HashMap T.Text H.ModuleName
+
+data Context
+  = Context
+  { cModuleMap :: ModuleMap
+  , cSettings  :: Settings
+  }
+
+type GenerateM = Reader Context
+
+gInclude :: FilePath -> Include SourcePos -> IO (H.ImportDecl, ModuleMap)
+gInclude dir i = do
+  -- TODO handle recursive includes ...
+  (Program headers _) <- loadFile (dir </> (T.unpack $ includePath i))
+  let modName = H.ModuleName $ fromMaybe "" (extractNamespace headers) <> extractModuleName (T.unpack $ includePath i) <> ".Types"
+  let thriftModName = T.pack $ dropExtension $ T.unpack $ includePath i
+  pure (H.ImportDecl modName True H.IEverything, Map.singleton thriftModName modName)
+
+gDefinition :: Definition SourcePos -> GenerateM ([H.Decl], [H.Decl], [H.Decl])
+gDefinition def = case def of
+  ConstDefinition _ -> pure ([], [], [])
+  TypeDefinition ty -> (\x -> (x, [], [])) <$> gType ty
+  ServiceDefinition s -> gService s
+
+gType :: Type SourcePos -> GenerateM [H.Decl]
+gType ty = case ty of
+  TypedefType t -> gTypedef t
+  EnumType e -> gEnum e
+  StructType s -> gStruct s
+  _ -> pure []
+
+gTypedef :: Typedef SourcePos -> GenerateM [H.Decl]
+gTypedef def = do
+  tyRef <- gTypeReference $ typedefTargetType def
+  pure [H.TypeDecl (H.TyCon $ capitalize $ typedefName $ def) tyRef]
+
+gTypeReference :: TypeReference SourcePos -> GenerateM H.Type
+gTypeReference ref = case ref of
+  StringType _ _ -> tyCon "Data.Text.Text"
+  BinaryType _ _ -> tyCon "Data.ByteString.ByteString"
+  BoolType _ _ -> tyCon "Prelude.Bool"
+  DoubleType _ _ -> tyCon "Prelude.Double"
+  I16Type _ _ -> tyCon "Data.Int.Int16"
+  I32Type _ _ -> tyCon "Data.Int.Int32"
+  I64Type _ _ -> tyCon "Data.Int.Int64"
+  ListType elemTy _ _ -> H.TyApp (H.TyCon $ "Data.Vector.Vector") <$> traverse gTypeReference [elemTy]
+  MapType kTy vTy _ _ -> H.TyApp (H.TyCon $ "Data.HashMap.Strict.HashMap") <$> traverse gTypeReference [kTy, vTy]
+  SetType ty _ _ -> H.TyApp (H.TyCon $ "Data.HashSet.HashSet") <$> traverse gTypeReference [ty]
+  DefinedType ty _ -> case T.splitOn "." ty of
+    xs@(x1:x2:_) -> do
+      map <- asks cModuleMap
+      case Map.lookup (mconcat $ init xs) map of
+        Nothing -> tyCon $ capitalize ty
+        Just (H.ModuleName n) -> pure $ H.TyCon $ n <> "." <> capitalize (last xs)
+    _ -> tyCon $ capitalize ty
+  ty -> error $ "Unsupported type: " <> show ty
+
+  where tyCon = pure . H.TyCon
+
+gEnum :: A.Enum SourcePos -> GenerateM [H.Decl]
+gEnum e = do
+  settings <- asks cSettings
+  pure (
+    [ H.DataDecl tyName cons [ derivingEq, derivingOrd, derivingGenerics, derivingShow, derivingBounded ]
+    , H.InstDecl (H.InstHead [] clPinchable (H.TyCon tyName))
+      [ H.TypeDecl (H.TyApp tag [ H.TyCon tyName ]) (H.TyCon $ "Pinch.TEnum")
+      , H.FunBind pinch'
+      , H.FunBind [unpinch']
+      ]
+    , H.InstDecl (H.InstHead [] "Prelude.Enum" (H.TyCon tyName))
+      [ H.FunBind fromEnum'
+      , H.FunBind (toEnum' ++ [toEnumDef])
+      ]
+    , H.InstDecl (H.InstHead [] clHashable (H.TyCon tyName)) []
+    ] ++ if sGenerateArbitrary settings then [
+      H.InstDecl (H.InstHead [] clArbitrary (H.TyCon tyName)) [
+        H.FunBind [ arbitrary ]
+      ]
+    ] else [])
+  where
+    tyName = enumName e
+    unpinch = H.Match "unpinch" [H.PVar "x"]
+      (H.EApp "Prelude.fmap" [ "Prelude.toEnum Prelude.. Prelude.fromIntegral", H.EApp "Pinch.unpinch" [ "x" ]])
+    (cons, fromEnum', toEnum', pinch', unpinchAlts') = unzip5 $ map gEnumDef $ zip [0..] $ enumValues e
+
+    defAlt = H.Alt (H.PVar "_")
+      (H.EApp "Prelude.fail"
+        [ H.EInfix "Prelude.<>"
+          (H.ELit $ H.LString $ "Unknown value for type " <> enumName e <> ": ")
+          (H.EApp "Prelude.show" [ "val"] )
+        ]
+      )
+    toEnumDef = H.Match "toEnum" [H.PVar "_"] (H.EApp "Prelude.error" [ H.ELit $ H.LString $ "Unknown value for enum " <> enumName e <> "." ])
+    unpinch' = H.Match "unpinch" [H.PVar "v"]
+      ( H.EDo
+        [ H.StmBind (Just $ H.PVar "val") (H.EApp "Pinch.unpinch" ["v"])
+        , H.StmBind Nothing (H.ECase (H.ETyAnn "val" (H.TyCon $ "Data.Int.Int32")) (unpinchAlts' ++ [defAlt]) )
+        ]
+      )
+    arbitrary = H.Match "arbitrary" [] (
+        H.EApp "Test.QuickCheck.elements" [H.EList $ map (H.EVar . enumDefName) $ enumValues e]
+      )
+
+gEnumDef :: (Integer, EnumDef SourcePos) -> (H.ConDecl, H.Match, H.Match, H.Match, H.Alt)
+gEnumDef (i, ed) =
+  ( H.ConDecl conName []
+  , H.Match "fromEnum" [H.PCon conName []] (H.ELit $ H.LInt index)
+  , H.Match "toEnum" [H.PLit $ H.LInt index] (H.EVar conName)
+  , H.Match "pinch" [H.PCon conName []]
+    ( H.EApp "Pinch.pinch"
+      [ H.ETyAnn (H.ELit $ H.LInt index) (H.TyCon $ "Data.Int.Int32") ]
+    )
+  , H.Alt (H.PLit $ H.LInt index) (H.EApp "Prelude.pure" [ H.EVar conName ])
+  )
+  where
+    index = fromMaybe i $ enumDefValue ed
+    conName = enumDefName ed
+
+gStruct :: Struct SourcePos -> GenerateM [H.Decl]
+gStruct s = case structKind s of
+  UnionKind -> (++ [hashable]) <$> unionDatatype tyName (structFields s) SRCNone
+  StructKind -> (++ [hashable]) <$> structDatatype tyName (structFields s)
+  ExceptionKind -> (++ [hashable, ex]) <$>  structDatatype tyName (structFields s)
+  where
+    tyName = structName s
+    hashable = H.InstDecl (H.InstHead [] clHashable (H.TyCon tyName)) []
+    ex = H.InstDecl (H.InstHead [] clException (H.TyCon tyName)) []
+
+
+structDatatype :: T.Text -> [Field SourcePos] -> GenerateM [H.Decl]
+structDatatype nm fs = do
+  fields <- traverse (gField $ decapitalize $ nm) $ zip [1..] fs
+  let (_, nms, tys, _) = unzip4 fields
+  let stag = H.TypeDecl (H.TyApp tag [ H.TyCon nm ]) (H.TyCon $ "Pinch.TStruct")
+  let pinch = H.FunBind
+        [ H.Match "pinch" [H.PCon nm $ map H.PVar nms]
+            ( H.EApp "Pinch.struct" [ H.EList $ flip map fields $ \(fId, fNm, fTy, fReq) ->
+              let
+                 op = if fReq then "Pinch..=" else "Pinch.?="
+               in H.EInfix op (H.ELit $ H.LInt fId) (H.EVar fNm)
+            ])
+        ]
+  let unpinch = H.FunBind
+        [ H.Match "unpinch" [H.PVar "value"] $
+            foldl'
+              (\acc (fId, fNm, fTy, fReq) ->
+                H.EInfix "Prelude.<*>" acc (
+                  H.EInfix (if fReq then "Pinch..:" else "Pinch..:?")
+                    "value"
+                    (H.ELit $  H.LInt fId)
+                )
+              )
+              (H.EApp "Prelude.pure" [ H.EVar $ nm ] )
+              fields
+        ]
+  let arbitrary = H.FunBind
+        [ H.Match "arbitrary" [] $
+            foldl'
+              (\acc _ ->
+                H.EInfix "Prelude.<*>" acc (
+                  "Test.QuickCheck.arbitrary"
+                )
+              )
+              (H.EApp "Prelude.pure" [ H.EVar $ nm ] )
+              fields
+        ]
+  settings <- asks cSettings
+  pure $
+    [ H.DataDecl nm
+      [ H.RecConDecl nm (zip nms tys)
+      ]
+      [ derivingEq, derivingGenerics, derivingShow ]
+    , H.InstDecl (H.InstHead [] clPinchable (H.TyCon nm)) [ stag, pinch, unpinch ]
+    ] ++ (if sGenerateArbitrary settings then [
+      H.InstDecl (H.InstHead [] clArbitrary (H.TyCon nm)) [ arbitrary ]
+    ] else [])
+
+data ServiceResultCon = SRCNone | SRCVoid H.Name
+
+unionDatatype :: T.Text -> [Field SourcePos] -> ServiceResultCon -> GenerateM [H.Decl]
+unionDatatype nm fs defCon = do
+  fields <- traverse (gField $ nm) $ zip [1..] $ map (\f -> f { fieldRequiredness = Just Required, fieldName = capitalize (fieldName f) } ) fs
+  let stag = H.TypeDecl (H.TyApp tag [ H.TyCon nm ]) (H.TyCon $ "Pinch.TUnion")
+  let pinch = H.FunBind $
+        map (\(fId, fNm, _, _) ->
+          H.Match "pinch" [H.PCon fNm [H.PVar "x"]]
+            ( H.EApp "Pinch.union" [ H.ELit $ H.LInt  fId, "x"]
+            )
+
+        ) fields ++ case defCon of
+          SRCNone -> []
+          SRCVoid c ->
+            [ H.Match "pinch" [H.PCon (nm <> c) []]
+              ( H.EApp "Pinch.pinch" [ "Pinch.Internal.RPC.Unit" ]
+              )
+            ]
+  let unpinch = H.FunBind
+        [ H.Match "unpinch" [H.PVar "v"] $
+            foldl'
+              (\acc (fId, fNm, _, _) ->
+                H.EInfix "Control.Applicative.<|>" acc (
+                  H.EInfix "Prelude.<$>"
+                    (H.EVar fNm)
+                    (H.EInfix "Pinch..:" "v" $ H.ELit $ H.LInt fId)
+                )
+              )
+              ( case defCon of
+                  SRCNone -> "Control.Applicative.empty"
+                  SRCVoid c ->
+                    H.EInfix "Prelude.<$" (H.EVar (nm <> c))
+                      "(Pinch.unpinch v :: Pinch.Parser Pinch.Internal.RPC.Unit)"
+              )
+              fields
+        ]
+  let cons = map (\(_, nm, ty, _) -> H.ConDecl nm [ ty ]) fields ++ case defCon of
+        SRCNone -> []
+        SRCVoid c -> [H.ConDecl (nm <> c) []]
+  let arbitrary = H.FunBind
+        [ H.Match "arbitrary" [] $
+            H.EApp "Test.QuickCheck.oneof"
+            [ H.EList $
+              map
+                (\(_, nm, _, _) ->
+                  H.EInfix "Prelude.<$>" (H.EVar nm) "Test.QuickCheck.arbitrary"
+                )
+                fields
+            ]
+        ]
+  settings <- asks cSettings
+  pure $
+    [ H.DataDecl nm
+      cons
+      [ derivingEq, derivingGenerics, derivingShow ]
+      , H.InstDecl (H.InstHead [] clPinchable (H.TyCon nm)) [ stag, pinch, unpinch ]
+    ] ++ (if sGenerateArbitrary settings then [
+      H.InstDecl (H.InstHead [] clArbitrary (H.TyCon nm)) [ arbitrary ]
+    ] else [])
+
+gField :: T.Text -> (Integer, Field SourcePos) -> GenerateM (Integer, H.Name, H.Type, Bool)
+gField prefix (i, f) = do
+  (req, ty) <- gFieldType f
+  let index = fromMaybe i (fieldIdentifier f)
+  pure (index, prefix <> "_" <> fieldName f, ty, req)
+
+
+gService :: Service SourcePos -> GenerateM ([H.Decl], [H.Decl], [H.Decl])
+gService s = do
+  (nms, tys, handlers, calls, tyDecls) <- unzip5 <$> traverse gFunction (serviceFunctions s)
+  let serverDecls =
+        [ H.DataDecl serviceTyName [ H.RecConDecl serviceConName $ zip nms tys ] []
+        , H.TypeSigDecl (prefix <> "_mkServer") (H.TyLam [H.TyCon serviceConName] (H.TyCon "Pinch.Server.ThriftServer"))
+        , H.FunBind
+          [ H.Match (prefix <> "_mkServer") [H.PVar "server"]
+            ( H.ELet "functions" 
+              (H.EApp "Data.HashMap.Strict.fromList" [ H.EList handlers ] )
+              ( H.EApp "Pinch.Server.createServer"
+                [ (H.ELam ["nm"]
+                    (H.EApp "Data.HashMap.Strict.lookup"
+                      [ "nm", "functions" ]
+                    )
+                  )
+                ]
+              )
+            )
+          ]
+        ]
+  pure (concat tyDecls, concat calls, serverDecls)
+  where
+    serviceTyName = capitalize $ serviceName s
+    serviceConName = capitalize $ serviceName s
+    prefix = decapitalize $ serviceName s
+
+gFieldType :: Field SourcePos -> GenerateM (Bool, H.Type)
+gFieldType f = do
+  ty <- gTypeReference (fieldValueType f)
+  case fieldRequiredness f of
+    Just Optional -> pure (False, H.TyApp (H.TyCon $ "Prelude.Maybe") [ ty ])
+    _ -> pure (True, ty)
+
+gFunction :: Function SourcePos -> GenerateM (H.Name, H.Type, H.Exp, [H.Decl], [H.Decl])
+gFunction f = do
+  argTys <- traverse (fmap snd . gFieldType) (functionParameters f)
+  retType <- maybe (pure tyUnit) gTypeReference (functionReturnType f)
+
+
+  argDataTy <- structDatatype argDataTyNm (functionParameters f)
+  let catchers = map
+        (\e -> H.EApp "Control.Exception.Handler"
+          [ H.EInfix "Prelude.." "Prelude.pure" (H.EVar $ dtNm <> "_" <> capitalize (fieldName e))
+          ]
+        ) exceptions
+  let resultField = fmap (\ty -> Field (Just 0) (Just Optional) ty "success" Nothing  [] Nothing (Pos.initialPos "")) (functionReturnType f)
+  (resultDecls, resultDataTy, resultDataCon) <- case (functionReturnType f, exceptions) of
+    (Nothing, []) -> pure ([], H.TyCon "Pinch.Internal.RPC.Unit", "Pinch.Internal.RPC.Unit")
+    _ -> do
+      let thriftResultInst = H.InstDecl (H.InstHead [] "Pinch.Internal.RPC.ThriftResult" (H.TyCon dtNm))
+            [ H.TypeDecl (H.TyApp (H.TyCon "ResultType") [ H.TyCon dtNm ]) retType
+            , H.FunBind (
+               map (\e -> H.Match "unwrap" [H.PCon (dtNm <> "_" <> capitalize (fieldName e)) [H.PVar "x"]] (H.EApp "Control.Exception.throwIO" ["x"])) exceptions
+               ++ [ H.Match "unwrap" [H.PCon (dtNm <> "_Success") (const (H.PVar "x") <$> maybeToList (functionReturnType f))] (H.EApp "Prelude.pure" (maybeToList $ ("x" <$ functionReturnType f) <|> pure "()"))]
+              )
+            , H.FunBind [H.Match "wrap" ["m"] (
+              ( H.EApp "Control.Exception.catches"
+                [ H.EInfix
+                    (if isNothing (functionReturnType f) then "Prelude.<$" else "Prelude.<$>")
+                    (H.EVar $ dtNm <> "_Success")
+                    "m"
+                , H.EList catchers
+                ]
+              ) ) ]
+            ]
+      dt <- unionDatatype
+        dtNm
+        (maybeToList resultField ++ exceptions)
+        (case functionReturnType f of
+          Nothing -> SRCVoid "_Success"
+          _ -> SRCNone
+        )
+      pure ((thriftResultInst : dt), H.TyCon dtNm, H.EVar $ dtNm <> "_Success")
+
+
+  let srvFunTy = H.TyLam ([H.TyCon "Pinch.Server.Context"] ++ argTys) (H.TyApp tyIO [retType])
+  let clientFunTy = H.TyLam argTys (H.TyApp (H.TyCon "Pinch.Client.ThriftCall") [resultDataTy])
+  let callSig = H.TypeSigDecl nm $ clientFunTy
+  let call = H.FunBind
+        [ H.Match nm ( map (H.PVar . fieldName) $ functionParameters f)
+          ( H.EApp (if functionOneWay f then "Pinch.Client.TOneway" else "Pinch.Client.TCall")
+            [ H.ELit $ H.LString $ functionName f
+            , H.EApp (H.EVar argDataTyNm) $ map (H.EVar . fieldName) (functionParameters f)
+            ]
+          )
+        ]
+  let handler = H.ETuple
+        [ H.ELit $ H.LString $ functionName f
+        , H.EApp (if functionOneWay f then "Pinch.Server.OnewayHandler" else "Pinch.Server.CallHandler")
+          [ H.ELam [ "ctx", H.PCon argDataTyNm (map H.PVar argVars) ] (
+              (if functionOneWay f then id else
+                (\c -> H.EApp (H.ETyApp "Pinch.Internal.RPC.wrap" [ resultDataTy ]) [c])
+              )
+              (H.EApp (H.EVar nm) (["server", "ctx"] ++ map H.EVar argVars))
+            )
+          ]
+        ]
+
+  pure ( nm, srvFunTy, handler, [callSig, call], (argDataTy ++ resultDecls))
+  where
+    nm = decapitalize $ functionName f
+    dtNm = capitalize (functionName f) <> "_Result"
+    argVars = take (length $ functionParameters f) $ map T.singleton ['a'..]
+    argDataTyNm = capitalize $ functionName f <> "_Args"
+    exceptions = concat $ maybeToList $ functionExceptions f
+
+tag = H.TyCon $ "Tag"
+clPinchable = "Pinch.Pinchable"
+clHashable = "Data.Hashable.Hashable"
+tyUnit = H.TyCon $ "()"
+tyIO = H.TyCon $ "Prelude.IO"
+clException = "Control.Exception.Exception"
+clArbitrary = "Test.QuickCheck.Arbitrary"
+
+decapitalize :: T.Text -> T.Text
+decapitalize s = if T.null s then "" else T.singleton (toLower $ T.head s) <> T.tail s
+
+capitalize :: T.Text -> T.Text
+capitalize s  = if T.null s then "" else T.singleton (toUpper $ T.head s) <> T.tail s
+
+derivingShow = H.DeriveClass $ H.TyCon $ "Prelude.Show"
+derivingEq = H.DeriveClass $ H.TyCon $ "Prelude.Eq"
+derivingOrd = H.DeriveClass $ H.TyCon $ "Prelude.Ord"
+derivingGenerics = H.DeriveClass $ H.TyCon $ "GHC.Generics.Generic"
+derivingBounded = H.DeriveClass $ H.TyCon $ "Prelude.Bounded"
diff --git a/src/Pinch/Generate/Pretty.hs b/src/Pinch/Generate/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Pinch/Generate/Pretty.hs
@@ -0,0 +1,216 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Pinch.Generate.Pretty where
+
+import           Data.String
+import qualified Data.Text                 as T
+import           Data.Text.Prettyprint.Doc
+
+newtype ModuleName = ModuleName T.Text
+  deriving (Show)
+type TypeName = T.Text
+type Name = T.Text
+type ClassName = T.Text
+
+data Module = Module
+  { modName    :: ModuleName
+  , modPragmas :: [Pragma]
+  , modImports :: [ImportDecl]
+  , modDecls   :: [Decl]
+  }
+  deriving (Show)
+
+data Pragma
+  = PragmaLanguage T.Text
+  | PragmaOptsGhc T.Text
+  deriving (Show)
+
+data ImportDecl = ImportDecl
+  { iName      :: ModuleName
+  , iQualified :: Bool
+  , iThings    :: ImportNames
+  }
+  deriving (Show)
+
+data ImportNames
+  = IEverything
+  | IJust [ Name ]
+  deriving (Show)
+
+data Decl
+  = TypeDecl Type Type
+  | DataDecl TypeName [ConDecl] [Deriving]
+  | InstDecl InstHead [Decl]
+  | FunBind [Match]
+  | TypeSigDecl Name Type
+  deriving (Show)
+
+data Deriving
+  = DeriveClass Type
+  deriving (Show)
+
+data ConDecl
+  = ConDecl Name [Type]
+  | RecConDecl Name [(Name, Type)]
+  deriving (Show)
+
+data Type
+  = TyApp Type [Type]
+  | TyCon TypeName
+  | TyLam [Type] Type
+  deriving (Show)
+
+
+data InstHead
+  = InstHead [Constraint] ClassName Type
+  deriving (Show)
+
+data Constraint
+  = CClass ClassName Type
+  deriving (Show)
+
+data Match = Match Name [Pat] Exp
+  deriving (Show)
+
+data Pat
+  = PVar Name
+  | PLit Lit
+  | PCon Name [Pat]
+  deriving (Show)
+
+data Exp
+  = EVar Name
+  | EApp Exp [Exp]
+  | ELit Lit
+  | ETyAnn Exp Type
+  | ECase Exp [Alt]
+  | EDo [Stm]
+  | EInfix Name Exp Exp
+  | EList [Exp]
+  | ELam [Pat] Exp
+  | ETuple [Exp]
+  | ELet Name Exp Exp
+  | ETyApp Exp [Type]
+  deriving (Show)
+
+data Stm
+  = StmBind (Maybe Pat) Exp
+  deriving (Show)
+
+data Alt
+  = Alt Pat Exp
+  deriving (Show)
+
+data Lit
+  = LInt Integer
+  | LString T.Text
+  deriving (Show)
+
+instance Pretty ModuleName where
+  pretty (ModuleName x) = pretty x
+
+instance Pretty Module where
+  pretty mod =
+       vsep (map pretty $ modPragmas mod) <> line <> line
+    <> "module" <+> pretty (modName mod) <+> "where" <> line <> line
+    <> vsep (map pretty $ modImports mod) <> line <> line
+    <> vsep (map pretty $ modDecls mod)
+
+instance Pretty Pragma where
+  pretty p = case p of
+    PragmaLanguage p -> "{-# LANGUAGE" <+> pretty p <+> "#-}"
+    PragmaOptsGhc o -> "{-# OPTIONS_GHC" <+> pretty o <+> "#-}"
+
+instance Pretty ImportDecl where
+  pretty i = "import" <+> (if (iQualified i) then "qualified" else "") <+> pretty (iName i) <> pretty (iThings i)
+
+instance Pretty ImportNames where
+  pretty i = case i of
+    IEverything -> ""
+    IJust xs -> " " <> (parens $ cList $ map pretty xs)
+
+instance Pretty Decl where
+  pretty decl = case decl of
+    TypeDecl t1 t2 -> "type" <+> pretty t1 <+> "=" <+> pretty t2 <> line
+    DataDecl t [] ds -> "data" <+> pretty t <+> prettyDerivings ds <> line
+    DataDecl t (c:cs) ds -> nest 2 (vsep $
+        [ "data" <+> pretty t
+        , "=" <+> pretty c
+        ] ++ (map (\c -> "|" <+> pretty c) cs) ++ [ prettyDerivings ds ]
+      ) <> line
+    InstDecl h decls -> (nest 2 $ vsep $ [ pretty h ] ++ map pretty decls) <> line
+    FunBind ms -> vsep (map pretty ms) <> line
+    TypeSigDecl n ty -> pretty n <+> "::" <+> pretty ty
+
+prettyDerivings :: [Deriving] -> Doc a
+prettyDerivings [] = ""
+prettyDerivings ds = "deriving" <+> (parens $ cList $ map pretty ds)
+
+instance Pretty Deriving where
+  pretty (DeriveClass c) = pretty c
+
+instance Pretty ConDecl where
+  pretty (ConDecl n args) = hsep $ [ pretty n ] ++ map pretty args
+  pretty (RecConDecl n args) = hsep $ [ pretty n, "{", fields, "}" ]
+    where fields = cList $ map (\(n, v) -> pretty n <+> "::" <+> pretty v) args
+
+instance Pretty InstHead where
+  pretty (InstHead cs n ty) = "instance" <> context <+> pretty n <+> pretty ty <+> "where"
+    where context = if null cs then "" else space <> parens (cList $ map pretty cs) <+> "=>" <+> pretty n <+> pretty ty <+> "where"
+
+instance Pretty Constraint where
+  pretty (CClass cl n) = pretty cl <+> pretty n
+
+instance Pretty Type where
+  pretty ty = case ty of
+    TyApp t1 ts -> parens $ pretty t1 <+> hsep (map pretty ts)
+    TyCon t -> pretty t
+    TyLam ts t -> concatWith (surround (space <> "->" <> space)) (map (parens . pretty) ts ++ [pretty t])
+
+instance Pretty Match where
+  pretty (Match n ps e) = pretty n <+> hsep (map pretty ps) <+> "=" <+> pretty e
+
+instance Pretty Pat where
+  pretty p = case p of
+    (PVar x) -> pretty x
+    (PLit i) -> pretty i
+    (PCon n []) -> pretty n
+    (PCon n xs) -> parens $ pretty n <+> hsep (map pretty xs)
+
+instance Pretty Exp where
+  pretty e = case e of
+    EVar n -> pretty n
+    EApp e es -> pretty e <+> hsep (map (parens . pretty) es)
+    ELit l -> pretty l
+    ETyAnn e ty -> parens $ pretty e <+> "::" <+> pretty ty
+    ECase e as -> nest 2 $ vsep $ ["case" <+> pretty e <+> "of"] ++ map pretty as
+    EDo s -> nest 2 $ vsep $ ["do"] ++ map pretty s
+    EInfix op e1 e2 -> parens $ hsep [ pretty e1, pretty op, pretty e2]
+    EList es -> "[" <+> cList (map pretty es) <+> "]"
+    ELam ps e -> parens $ "\\" <> hsep (map pretty ps) <+> "->" <+> pretty e
+    ETuple es -> nest 2 $ tupled $ map pretty es
+    ELet nm e1 e2 -> "let" <+> pretty nm <+> "=" <+> indent 2 (pretty e1) <+> "in" <+> pretty e2
+    ETyApp e tys -> pretty e <+>  hsep (map (("@"<>) . parens . pretty) tys)
+
+instance Pretty Alt where
+  pretty (Alt p e) = pretty p <+> "->" <+> pretty e
+
+instance Pretty Stm where
+  pretty s = case s of
+    StmBind Nothing e -> pretty e
+    StmBind (Just p) e -> pretty p <+> "<-" <+> pretty e
+
+instance Pretty Lit where
+  pretty l = case l of
+    LInt i -> pretty i
+    LString t -> "\"" <> pretty t <> "\""
+
+cList = concatWith (surround (comma <> space))
+
+
+instance IsString Exp where
+  fromString = EVar . T.pack
+
+instance IsString Pat where
+  fromString = PVar . T.pack