diff --git a/packages/backend-lalr/happy-backend-lalr.cabal b/packages/backend-lalr/happy-backend-lalr.cabal
index cc9eeae4..ebeaa9cf 100644
--- a/packages/backend-lalr/happy-backend-lalr.cabal
+++ b/packages/backend-lalr/happy-backend-lalr.cabal
@@ -47,11 +47,14 @@ library
                        Happy.Backend.LALR.ProduceCode
   build-depends:       base < 5,
                        array,
+                       mtl > 2,
+                       containers,
                        happy-codegen-common == 1.21.0,
                        happy-grammar == 1.21.0,
-                       happy-tabular == 1.21.0
+                       happy-tabular == 1.21.0,
+                       happy-code-combinators == 1.21.0
 
   default-language:    Haskell98
-  default-extensions:  CPP, MagicHash, FlexibleContexts
+  default-extensions:  CPP, MagicHash, FlexibleContexts, OverloadedStrings
   ghc-options:         -Wall
   other-modules:       Paths_happy_backend_lalr
diff --git a/packages/backend-lalr/src/Happy/Backend/LALR/ProduceCode.lhs b/packages/backend-lalr/src/Happy/Backend/LALR/ProduceCode.lhs
index 30d8a9b6..b5cfeed2 100644
--- a/packages/backend-lalr/src/Happy/Backend/LALR/ProduceCode.lhs
+++ b/packages/backend-lalr/src/Happy/Backend/LALR/ProduceCode.lhs
@@ -25,6 +25,9 @@ The code generator.
 > import Data.Array.MArray         ( MArray(..), freeze, readArray, writeArray )
 > import Data.Array.IArray         ( Array, IArray(..), (!), array, assocs, elems )
 
+> import Happy.Backend.CodeCombinators
+> import Happy.Backend.CodeCombinators.Syntax
+
 %-----------------------------------------------------------------------------
 Produce the complete output file.
 
@@ -581,28 +584,118 @@ machinery to discard states in the parser...
 >    produceActionTable TargetArrayBased
 >       = produceActionArray
 >       . produceReduceArray
->       . str "happy_n_terms = " . shows n_terminals . str " :: Prelude.Int\n"
->       . str "happy_n_nonterms = " . shows n_nonterminals . str " :: Prelude.Int\n\n"
->
+>       . renderDocDecs [
+>             fullFunD "happy_n_terms" intT
+>               [clause [] (intE n_terminals) []]
+>           , fullFunD "happy_n_nonterms_name" intT
+>               [clause [] (intE n_nonterminals) []]
+>         ]
+>       . nl
+
 >    produceExpListPerState
->       = produceExpListArray
->       . str "{-# NOINLINE happyExpListPerState #-}\n"
->       . str "happyExpListPerState st =\n"
->       . str "    token_strs_expected\n"
->       . str "  where token_strs = " . str (show $ elems token_names') . str "\n"
->       . str "        bit_start = st Prelude.* " . str (show nr_tokens) . str "\n"
->       . str "        bit_end = (st Prelude.+ 1) Prelude.* " . str (show nr_tokens) . str "\n"
->       . str "        read_bit = readArrayBit happyExpList\n"
->       . str "        bits = Prelude.map read_bit [bit_start..bit_end Prelude.- 1]\n"
->       . str "        bits_indexed = Prelude.zip bits [0.."
->                                        . str (show (nr_tokens - 1)) . str "]\n"
->       . str "        token_strs_expected = Prelude.concatMap f bits_indexed\n"
->       . str "        f (Prelude.False, _) = []\n"
->       . str "        f (Prelude.True, nr) = [token_strs Prelude.!! nr]\n"
->       . str "\n"
+>       =
+>         produceExpListArray
+>       . renderDocDecs [[noInlinePragmaD happy_exp_list_per_state_name, happy_exp_list_per_state_dec]]
+>       . nl
 >       where (first_token, last_token) = bounds token_names'
 >             nr_tokens = last_token - first_token + 1
 >
+>          --happyExpListPerState st = token_strs_expected
+>             happy_exp_list_per_state_name = "happyExpListPerState"
+>             happy_exp_list_per_state_dec =
+>               funD happy_exp_list_per_state_name [
+>                 clause [st_pat] (varE token_strs_expected_name) [
+>                   token_strs_dec,
+>                   bit_start_dec,
+>                   bit_end_dec,
+>                   read_bit_dec,
+>                   bits_dec,
+>                   bits_indexed_dec,
+>                   f_dec,
+>                   token_strs_expected_dec
+>                 ]
+>               ]
+>
+>             st_name = "st"
+>             st_var = varE st_name
+>             st_pat = varP st_name
+>
+>           --token_strs = elems token_names'
+>             token_strs_name = "token_strs"
+>             token_strs_dec = funD token_strs_name [clause [] token_strs_exp []]
+>                 where token_strs_exp = listE [stringE str_elem | str_elem <- elems token_names']
+>
+>           --bit_start = st Prelude.* nr_tokens
+>             bit_start_name = "bit_start"
+>             bit_start_dec = funD bit_start_name [clause [] bit_start_exp []]
+>                 where bit_start_exp = appManyArgsE mulE [st_var, intE nr_tokens]
+>
+>           --bit_end = (st Prelude.+ 1) Prelude.* nr_tokens
+>             bit_end_name = "bit_end"
+>             bit_end_dec = funD bit_end_name [clause [] bit_end_exp []]
+>                 where bit_end_exp = appManyArgsE mulE [appManyArgsE addE [st_var, intE 1], intE nr_tokens]
+>
+>           --read_bit = readArrayBit happyExpList
+>             read_bit_name = "read_bit"
+>             read_bit_dec = funD read_bit_name [clause [] read_bit_exp []]
+>                 where read_bit_exp = appE (varE "readArrayBit") (varE "happyExpList")
+>
+>           --bits = Prelude.map read_bit [bit_start..bit_end Prelude.- 1]
+>             bits_name = "bits"
+>             bits_dec = funD bits_name [clause [] bits_exp []]
+>                 where bits_exp =
+>                         appManyArgsE
+>                           (varE "Prelude.map")
+>                           [
+>                               varE read_bit_name
+>                             , arithSeqE $
+>                                 FromToR
+>                                   (varE bit_start_name)
+>                                   (appManyArgsE subE [varE bit_end_name, intE 1])
+>                           ]
+>
+>           --bits_indexed = Prelude.zip bits [0... nr_tokens - 1]
+>             bits_indexed_name = "bits_indexed"
+>             bits_indexed_dec = funD bits_indexed_name [clause [] bits_indexed_exp []]
+>                 where bits_indexed_exp =
+>                         appManyArgsE
+>                           (varE "Prelude.zip")
+>                           [
+>                               varE bits_name
+>                             , arithSeqE $
+>                                 FromToR
+>                                   (intE 0)
+>                                   (intE $ nr_tokens - 1)
+>                           ]
+>
+>           --f (Prelude.False, _) = []\n"
+>           --f (Prelude.True, nr) = [token_strs Prelude.!! nr]\n
+>             f_name = "f"
+>             f_dec  = funD f_name [clause1, clause2]
+>                 where clause1 = clause [tupP [falseP, wildP]] emptyListE []
+>                       clause2 = clause [tupP [trueP, varP nr]] exp2 []
+>                       nr = "nr"
+>                       exp2 =
+>                         listE [
+>                           appManyArgsE
+>                             (varE "(Prelude.!!)")
+>                             [
+>                                 varE token_strs_name
+>                               , varE nr
+>                             ]
+>                         ]
+>
+>           --token_strs_expected = Prelude.concatMap f token_strs_name = "token_strs"
+>             token_strs_expected_name = "token_strs_expected"
+>             token_strs_expected_dec = funD token_strs_expected_name [clause [] token_strs_expected_exp []]
+>                 where token_strs_expected_exp =
+>                         appManyArgsE
+>                           (varE "Prelude.concatMap")
+>                           [
+>                               varE f_name
+>                             , varE bits_indexed_name
+>                           ]
+>
 >    produceStateFunction goto' (state, acts)
 >       = foldr (.) id (map produceActions assocs_acts)
 >       . foldr (.) id (map produceGotos   (assocs gotos))
@@ -726,16 +819,36 @@ action array indexed by (terminal * last_state) + state
 
 >    produceExpListArray
 >       | ghc
->           = str "happyExpList :: HappyAddr\n"
->           . str "happyExpList = HappyA# \"" --"
->           . str (hexChars explist)
->           . str "\"#\n\n" --"
+>           =
+>           -- happyExpList :: HappyAddr
+>           -- happyExpList = HappyA# "hexCharsE explist"#
+>           let happy_exp_list_exp =
+>                 appE (conE "HappyA#") (hexCharsE explist)
+>               happy_exp_list_dec =
+>                 fullFunD "happyExpList" (conT "HappyAddr")
+>                   [(clause [] happy_exp_list_exp [])]
+>           in
+>           renderDocDecs [happy_exp_list_dec]
 >       | otherwise
->           = str "happyExpList :: Happy_Data_Array.Array Prelude.Int Prelude.Int\n"
->           . str "happyExpList = Happy_Data_Array.listArray (0,"
->               . shows table_size . str ") (["
->           . interleave' "," (map shows explist)
->           . str "\n\t])\n\n"
+>           =
+>           -- happyExpList :: Happy_Data_Array.Array Prelude.Int Prelude.Int
+>           -- happyExpList = Happy_Data_Array.listArray (0, table_size) [explist]
+>           let happy_exp_list_type =
+>                 appManyArgsT
+>                   (conT "Happy_Data_Array.Array")
+>                   [intT, intT]
+>               happy_exp_list_exp =
+>                 appManyArgsE
+>                   (varE "Happy_Data_Array.listArray")
+>                   [
+>                       tupE [intE 0, intE table_size]
+>                     , listE $ intE <$> explist
+>                   ]
+>               happy_exp_list_dec =
+>                 fullFunD "happyExpList" happy_exp_list_type
+>                   [(clause [] happy_exp_list_exp [])]
+>           in
+>           renderDocDecs [happy_exp_list_dec]
 
 >    (_, last_state) = bounds action
 >    n_states = last_state + 1
diff --git a/packages/code-combinators/happy-code-combinators.cabal b/packages/code-combinators/happy-code-combinators.cabal
new file mode 100644
index 00000000..0a7babac
--- /dev/null
+++ b/packages/code-combinators/happy-code-combinators.cabal
@@ -0,0 +1,88 @@
+name:            happy-code-combinators
+version:         1.21.0
+license:         BSD2
+license-file:    LICENSE
+copyright:       (c) Andy Gill, Simon Marlow
+author:          Artem Zakharenko
+maintainer:      Artem Zakharenko <zakhart1234567890@gmail.com>
+bug-reports:     https://github.com/simonmar/happy/issues
+stability:       not-stable
+homepage:        https://www.haskell.org/happy/
+category:        Development
+cabal-version:   >= 1.10
+build-type:      Simple
+synopsis:        Code combinators for simple code generation
+
+Description:
+  Happy is a parser generator for Haskell.
+  Happy-Backend-CodeCombinators allows to generate code
+  in both abstract and text represantation.
+
+
+tested-with:
+        GHC == 9.2.1
+        GHC == 9.0.2
+        GHC == 8.10.7
+        GHC == 8.8.4
+        GHC == 8.6.5
+        GHC == 8.4.4
+        GHC == 8.2.2
+        GHC == 8.0.2
+        GHC == 7.10.3
+        GHC == 7.8.4
+        GHC == 7.6.3
+        GHC == 7.4.2
+        GHC == 7.0.4
+
+library
+  hs-source-dirs:      src
+
+  exposed-modules:     Happy.Backend.CodeCombinators,
+                       Happy.Backend.CodeCombinators.Abstract,
+                       Happy.Backend.CodeCombinators.Syntax
+
+  build-depends:       array,
+                       base < 5,
+                       containers,
+                       mtl,
+                       pretty,
+                       template-haskell
+
+  default-language:    Haskell98
+  default-extensions:  CPP,
+                       FlexibleContexts,
+                       InstanceSigs,
+                       KindSignatures,
+                       MagicHash,
+                       OverloadedStrings,
+                       TypeFamilyDependencies
+
+  ghc-options:         -Wall -Wno-orphans
+
+
+test-suite test
+  type: exitcode-stdio-1.0
+  main-is: Test.hs
+  other-modules:
+      Test.CodeCombinators.Common
+    , Test.CodeCombinators.GenExp
+    , Test.CodeCombinators.GenDec
+    , Test.CodeCombinators.GenPat
+    , Test.CodeCombinators.GenType
+
+  hs-source-dirs:
+      test
+
+  default-extensions:
+      OverloadedStrings
+    , TemplateHaskell
+
+  ghc-options: -Wall
+  build-depends:
+      base < 5
+    , happy-code-combinators
+    , haskell-src-meta
+    , hedgehog
+    , template-haskell
+
+  default-language: Haskell98
diff --git a/packages/code-combinators/src/Happy/Backend/CodeCombinators.hs b/packages/code-combinators/src/Happy/Backend/CodeCombinators.hs
new file mode 100644
index 00000000..977c8323
--- /dev/null
+++ b/packages/code-combinators/src/Happy/Backend/CodeCombinators.hs
@@ -0,0 +1,110 @@
+module Happy.Backend.CodeCombinators where
+
+import qualified Language.Haskell.TH as TH
+import Control.Monad.State
+import qualified Data.Map as Map
+import Data.Kind (Type)
+import Data.Foldable
+import Data.String
+
+class (IsString (NameT e), Monad (NewNameM e)) => CodeGen e where
+  type NameT e = n | n -> e
+  type RangeT e = r | r -> e
+  type TypeT e = t | t -> e
+  type PatT e = p | p -> e
+  type DecT e = d | d -> e
+  type ClauseT e = c | c -> e
+  type NewNameM e :: Type -> Type
+
+  mkName :: String -> NameT e
+  mkOpName :: String -> NameT e
+  newName :: String -> NewNameM e (NameT e)
+
+  intE :: Int -> e
+  negateE :: e -> e
+  stringE :: String -> e
+  hexCharsE :: [Int] -> e
+
+  conE :: NameT e -> e
+  varE :: NameT e -> e
+  appE :: e -> e -> e
+
+  tupE :: [e] -> e
+  listE :: [e] -> e
+  arithSeqE :: RangeT e -> e
+
+  conT :: NameT e -> TypeT e
+  varT :: NameT e -> TypeT e
+  appT :: TypeT e -> TypeT e -> TypeT e
+
+  litP :: TH.Lit -> PatT e
+  varP :: NameT e -> PatT e
+  tupP :: [PatT e] -> PatT e
+  conP :: NameT e -> [PatT e] -> PatT e
+  wildP :: PatT e
+
+  clause :: [PatT e] -> e -> [DecT e] -> ClauseT e
+
+  sigD :: NameT e -> TypeT e -> DecT e
+  funD :: NameT e -> [ClauseT e] -> DecT e
+  noInlinePragmaD :: NameT e -> DecT e
+
+
+trueE :: CodeGen e => e
+trueE = conE "Prelude.True"
+
+falseE :: CodeGen e => e
+falseE = conE "Prelude.False"
+
+trueP :: CodeGen e => PatT e
+trueP = conP "Prelude.True" []
+
+falseP :: CodeGen e => PatT e
+falseP = conP "Prelude.False" []
+
+mulE :: CodeGen e => e
+mulE = varE $ mkOpName "Prelude.*"
+
+addE :: CodeGen e => e
+addE = varE $ mkOpName "Prelude.+"
+
+subE :: CodeGen e => e
+subE = varE $ mkOpName "Prelude.-"
+
+intT :: CodeGen e => TypeT e
+intT = conT "Prelude.Int"
+
+appManyArgsE :: CodeGen e => e -> [e] -> e
+appManyArgsE fun args = foldl' appE fun args
+
+appManyArgsT :: CodeGen e => TypeT e -> [TypeT e] -> TypeT e
+appManyArgsT fun args = foldl' appT fun args
+
+emptyListE :: CodeGen e => e
+emptyListE = conE "[]"
+
+emptyListP :: CodeGen e => PatT e
+emptyListP = conP "[]" []
+
+fullFunD :: CodeGen e => NameT e -> TypeT e -> [ClauseT e] -> [DecT e]
+fullFunD name type_ clauses =
+  [
+      sigD name type_
+    , funD name clauses
+  ]
+
+-- this monad keeps map from String names representation to Name
+type NameContext e r = StateT (Map.Map String (NameT e)) (NewNameM e) r
+
+-- returns the name if it already exists
+-- otherwise function creates a new name, puts it in the map, and returns that name
+getName ::  CodeGen e => String -> NameContext e (NameT e)
+getName str_name = do
+  maybe_name <- gets (Map.lookup str_name)
+  case maybe_name of
+    Just name ->
+      return name
+    Nothing -> do
+      newName_ <- lift $ newName str_name
+      modify $ \treeMap -> Map.insert str_name newName_ treeMap
+      return newName_
diff --git a/packages/code-combinators/src/Happy/Backend/CodeCombinators/Abstract.hs b/packages/code-combinators/src/Happy/Backend/CodeCombinators/Abstract.hs
new file mode 100644
index 00000000..7740eb64
--- /dev/null
+++ b/packages/code-combinators/src/Happy/Backend/CodeCombinators/Abstract.hs
@@ -0,0 +1,116 @@
+module Happy.Backend.CodeCombinators.Abstract where
+
+import Happy.Backend.CodeCombinators
+import qualified Language.Haskell.TH as TH
+import Data.Word
+import Data.String
+
+instance CodeGen TH.Exp where
+  type NameT TH.Exp = TH.Name
+  type RangeT TH.Exp  = TH.Range
+  type TypeT TH.Exp = TH.Type
+  type PatT TH.Exp = TH.Pat
+  type DecT TH.Exp = TH.Dec
+  type ClauseT TH.Exp = TH.Clause
+  type NewNameM TH.Exp = TH.Q
+
+  mkName :: String -> TH.Name
+  mkName = TH.mkName
+
+  mkOpName :: String -> TH.Name
+  mkOpName = TH.mkName
+
+  newName :: String -> TH.Q TH.Name
+  newName = TH.newName
+
+  negateE :: TH.Exp -> TH.Exp
+  negateE = TH.AppE (TH.VarE $ mkName "GHC.Num.negate")
+
+  intE :: Int -> TH.Exp
+  intE num
+    | num < 0 = negateE absE
+    | otherwise = absE
+    where absE =
+            TH.LitE $ TH.IntegerL $
+            abs $ fromIntegral num
+
+  stringE :: String -> TH.Exp
+  stringE str = TH.LitE $ TH.StringL str
+
+  hexCharsE :: [Int] -> TH.Exp
+  hexCharsE ls =
+    TH.LitE $ TH.StringPrimL hexChars
+    where
+      -- these functions are analogues of the functions from ProduceCode.lhs (happy-backend-lalr package)
+      hexChars :: [Word8]
+      hexChars = concatMap hexChar ls
+
+      hexChar :: Int -> [Word8]
+      hexChar i | i < 0 = hexChar (i + 65536)
+      hexChar i =  toHex (i `mod` 256) ++ toHex (i `div` 256)
+
+      toHex :: Int -> [Word8]
+      toHex i = [hexDig (i `div` 16), hexDig (i `mod` 16)]
+
+      hexDig :: Int -> Word8
+      hexDig = fromIntegral
+
+  conE :: TH.Name  -> TH.Exp
+  conE = TH.ConE
+
+  varE :: TH.Name -> TH.Exp
+  varE = TH.VarE
+
+  appE :: TH.Exp -> TH.Exp -> TH.Exp
+  appE = TH.AppE
+
+
+  tupE :: [TH.Exp] -> TH.Exp
+  tupE es = TH.TupE $ map Just es
+
+  listE :: [TH.Exp] -> TH.Exp
+  listE = TH.ListE
+
+  arithSeqE :: TH.Range -> TH.Exp
+  arithSeqE = TH.ArithSeqE
+
+  conT :: TH.Name -> TH.Type
+  conT = TH.ConT
+
+  varT :: TH.Name -> TH.Type
+  varT = TH.VarT
+
+  appT :: TH.Type -> TH.Type -> TH.Type
+  appT = TH.AppT
+
+  litP :: TH.Lit -> TH.Pat
+  litP = TH.LitP
+
+  varP :: TH.Name -> TH.Pat
+  varP = TH.VarP
+
+  tupP :: [TH.Pat] -> TH.Pat
+  tupP = TH.TupP
+
+  conP :: TH.Name -> [TH.Pat] -> TH.Pat
+  conP = TH.ConP
+
+  wildP :: TH.Pat
+  wildP = TH.WildP
+
+  clause :: [TH.Pat] -> TH.Exp -> [TH.Dec] -> TH.Clause
+  clause ps e decs = TH.Clause ps (TH.NormalB e) decs
+
+  sigD :: TH.Name -> TH.Type -> TH.Dec
+  sigD = TH.SigD
+
+  funD :: TH.Name -> [TH.Clause] -> TH.Dec
+  funD = TH.FunD
+
+  noInlinePragmaD :: TH.Name -> TH.Dec
+  noInlinePragmaD name =
+    TH.PragmaD $
+      TH.InlineP name TH.NoInline TH.FunLike TH.AllPhases
+
+instance IsString TH.Name where
+  fromString = mkName
diff --git a/packages/code-combinators/src/Happy/Backend/CodeCombinators/Syntax.hs b/packages/code-combinators/src/Happy/Backend/CodeCombinators/Syntax.hs
new file mode 100644
index 00000000..71f31925
--- /dev/null
+++ b/packages/code-combinators/src/Happy/Backend/CodeCombinators/Syntax.hs
@@ -0,0 +1,229 @@
+module Happy.Backend.CodeCombinators.Syntax
+  (
+    DocExp(..),
+    DocName(..),
+    DocClause(..),
+    DocDec(..),
+    DocRange(..),
+    DocPat(..),
+    DocType(..),
+    CodeGen(..),
+    renderDocDecs,
+    renderDocDec,
+    renderE,
+    renderP,
+    renderT
+  )
+  where
+
+import Happy.Backend.CodeCombinators
+import qualified Text.PrettyPrint as PP
+import qualified Language.Haskell.TH as TH
+import Control.Monad.Identity (Identity)
+import Data.Char (chr, ord)
+import Data.String
+
+newtype Prec = Prec Int
+  deriving (Eq, Ord, Show, Bounded)
+
+atomPrec, appPrec, noPrec :: Prec
+atomPrec = Prec maxBound
+appPrec = Prec 10
+noPrec = Prec (-1)
+
+
+newtype DocExp = DocExp (Prec -> PP.Doc)
+newtype DocType = DocType (Prec -> PP.Doc)
+newtype DocPat = DocPat (Prec -> PP.Doc)
+
+newtype DocName = DocName PP.Doc
+  deriving (Eq, Show)
+newtype DocClause = DocClause PP.Doc
+  deriving (Eq, Show)
+newtype DocDec = DocDec PP.Doc
+  deriving (Eq, Show)
+
+data DocRange
+  = FromToR DocExp DocExp
+
+instance CodeGen DocExp where
+  type NameT DocExp = DocName
+  type RangeT DocExp = DocRange
+  type TypeT DocExp = DocType
+  type PatT DocExp = DocPat
+  type DecT DocExp = DocDec
+  type ClauseT DocExp = DocClause
+  type NewNameM DocExp = Identity
+
+  mkName :: String -> DocName
+  mkName name = DocName $ PP.text name
+
+  mkOpName :: String -> DocName
+  mkOpName name = DocName $ PP.parens $ PP.text name
+
+  newName :: String -> Identity DocName
+  newName = return . mkName
+
+  negateE :: DocExp -> DocExp
+  negateE = appE $ varE "GHC.Num.negate"
+
+  intE :: Int -> DocExp
+  intE num
+    | num < 0 = negateE $ absE
+    | otherwise = absE
+    where absE =
+            DocExp $ \_ ->
+              PP.integer $ abs $ fromIntegral $ num
+
+  stringE :: String -> DocExp
+  stringE str = DocExp $ \_ -> PP.doubleQuotes $ PP.text $ escape str
+
+  hexCharsE :: [Int] -> DocExp
+  hexCharsE ls =
+    DocExp $ \_ ->
+      (PP.doubleQuotes $ PP.text hexChars) PP.<> PP.text "#"
+    where
+      -- these functions are taken from ProduceCode.lhs (happy-backend-lalr package)
+      hexChars :: String
+      hexChars = concatMap hexChar ls
+
+      hexChar :: Int -> String
+      hexChar i | i < 0 = hexChar (i + 65536)
+      hexChar i =  toHex (i `mod` 256) ++ toHex (i `div` 256)
+
+      toHex :: Int -> String
+      toHex i = ['\\','x', hexDig (i `div` 16), hexDig (i `mod` 16)]
+
+      hexDig :: Int -> Char
+      hexDig i | i <= 9    = chr (i + ord '0')
+               | otherwise = chr (i - 10 + ord 'a')
+
+  conE :: DocName -> DocExp
+  conE (DocName name) = DocExp $ \_ -> name
+
+  varE :: DocName -> DocExp
+  varE (DocName name) = DocExp $ \_ -> name
+
+  appE :: DocExp -> DocExp -> DocExp
+  appE (DocExp e1) (DocExp e2) =
+    DocExp $ \p ->
+      parensIf (p > appPrec) $
+      PP.sep [e1 appPrec, e2 atomPrec]
+
+
+  tupE :: [DocExp] -> DocExp
+  tupE ds =
+    DocExp $ \_ ->
+      PP.parens $ PP.sep $ PP.punctuate PP.comma $
+      [d noPrec | DocExp d <- ds]
+
+  listE :: [DocExp] -> DocExp
+  listE ds =
+    DocExp $ \_ ->
+      PP.brackets $ PP.sep $ PP.punctuate PP.comma $
+      [d noPrec | DocExp d <- ds]
+
+  arithSeqE :: DocRange -> DocExp
+  arithSeqE (FromToR (DocExp e1) (DocExp e2)) =
+    DocExp $ \_ ->
+      PP.brackets  $ e1 noPrec PP.<+> PP.text ".." PP.<+> e2 noPrec
+
+  conT :: DocName -> DocType
+  conT (DocName name) = DocType $ \_ -> name
+
+  varT :: DocName -> DocType
+  varT (DocName name) = DocType $ \_ -> name
+
+  appT :: DocType -> DocType -> DocType
+  appT (DocType t1) (DocType t2) =
+    DocType $ \p ->
+      parensIf (p > appPrec) $
+      PP.sep [t1 appPrec, t2 atomPrec]
+
+  litP :: TH.Lit -> DocPat
+  litP (TH.CharL c) = DocPat $ \_ -> PP.quotes $ PP.text $ escape [c]
+  litP (TH.StringL s) = DocPat $ \_ -> PP.doubleQuotes $ PP.text $ escape s
+  litP (TH.IntegerL n) = DocPat $ \_ -> parensIf (n < 0) $ PP.text $ show n
+  litP l = error $ "unsupported literal: " ++ show l
+
+  varP :: DocName -> DocPat
+  varP (DocName name)    = DocPat $ \_ -> name
+
+  tupP :: [DocPat] -> DocPat
+  tupP ps =
+    DocPat $ \_ ->
+      PP.parens $ PP.sep $
+      PP.punctuate PP.comma [p noPrec | DocPat p <- ps]
+
+  conP :: DocName -> [DocPat] -> DocPat
+  conP (DocName name) ps =
+    DocPat $ \p ->
+      parensIf (p > appPrec) $
+      name PP.<+> PP.sep [pt atomPrec | DocPat pt <- ps]
+
+  wildP :: DocPat
+  wildP = DocPat $ \_ -> PP.text "_"
+
+  clause :: [DocPat] -> DocExp -> [DocDec] -> DocClause
+  clause ps (DocExp exp_) decs =
+    DocClause $
+      (PP.sep [p atomPrec | DocPat p <- ps] PP.<+> PP.text "=" PP.<+> exp_ noPrec)
+      PP.$+$ PP.nest 4 whereSection
+    where whereSection =
+            case decs of
+              [] -> PP.empty
+              _  ->
+                PP.text "where" PP.$+$
+                foldr (PP.$+$) PP.empty [PP.nest 4 dec | DocDec dec <- decs]
+
+  sigD :: DocName -> DocType -> DocDec
+  sigD (DocName name) (DocType type_) = DocDec $ name PP.<+> PP.text "::" PP.<+> type_ noPrec
+
+  funD :: DocName -> [DocClause] -> DocDec
+  funD (DocName name) cls = DocDec $ foldr1 (PP.$+$) [name PP.<+> cl | DocClause cl <- cls]
+
+  noInlinePragmaD :: DocName -> DocDec
+  noInlinePragmaD (DocName name) =
+    DocDec $
+      PP.text "{-# NOINLINE" PP.<+> name PP.<+> PP.text "#-}"
+
+instance IsString DocName where
+  fromString = mkName
+
+escape :: String -> String
+escape ('\'':xs) = '\\' : '\'' : escape xs
+escape ('\"':xs) = '\\' : '\"' : escape xs
+escape ('\\':xs) = '\\' : '\\' : escape xs
+escape (x:xs) = x : escape xs
+escape [] = []
+
+fromTextDetails :: PP.TextDetails -> ShowS
+fromTextDetails td =
+  case td of
+    PP.Chr c -> (c:)
+    PP.Str str -> (str++)
+    PP.PStr str -> (str++)
+
+renderE :: DocExp -> ShowS
+renderE (DocExp exp_) = showString $ PP.render $ exp_ noPrec
+
+renderP :: DocPat -> ShowS
+renderP (DocPat pat) = showString $ PP.render $ pat noPrec
+
+renderT :: DocType -> ShowS
+renderT (DocType tp) = showString $ PP.render $ tp noPrec
+
+
+renderDocDec :: DocDec -> ShowS
+renderDocDec (DocDec dec) = showString $ PP.render dec
+
+renderDocDecs :: [[DocDec]] -> ShowS
+renderDocDecs dss =
+  PP.fullRender PP.PageMode 120 1.5 (\td s -> fromTextDetails td . s) id d
+  where
+    d = PP.vcat (map renderGroup dss)
+    renderGroup ds = PP.vcat [ d1 | DocDec d1 <- ds ] PP.$+$ PP.text ""
+
+parensIf :: Bool -> PP.Doc -> PP.Doc
+parensIf True = PP.parens
+parensIf False = id
diff --git a/packages/code-combinators/test/Test.hs b/packages/code-combinators/test/Test.hs
new file mode 100644
index 00000000..5d2760b4
--- /dev/null
+++ b/packages/code-combinators/test/Test.hs
@@ -0,0 +1,46 @@
+import Hedgehog
+import Test.CodeCombinators.GenExp
+import Test.CodeCombinators.GenPat
+import Test.CodeCombinators.GenType
+import Test.CodeCombinators.GenDec
+import Language.Haskell.Meta.Parse
+import Data.Either
+
+prop_exp :: Property
+prop_exp =
+  property $ do
+    exp_ <- forAll genExp
+    let parse_result = parseExp (expToString exp_)
+    assert $ isRight parse_result
+    let Right result = parse_result
+    exp_ === deleteParensE result
+
+prop_pat :: Property
+prop_pat =
+  property $ do
+    pat <- forAll genPat
+    let parse_result = parsePat (patToString pat)
+    assert $ isRight parse_result
+    let Right result = parse_result
+    pat === deleteParensP result
+
+prop_type :: Property
+prop_type =
+  property $ do
+    pat <- forAll genType
+    let parse_result = parseType (typeToString pat)
+    assert $ isRight parse_result
+    let Right result = parse_result
+    pat === deleteParensT result
+
+prop_dec :: Property
+prop_dec =
+  property $ do
+    ds <- forAll genDecList
+    let parse_result = parseDecs (decListToString ds)
+    assert $ isRight parse_result
+    let Right result = parse_result
+    ds === deleteParensDecList result
+
+main :: IO Bool
+main = checkParallel $$(discover)
diff --git a/packages/code-combinators/test/Test/CodeCombinators/Common.hs b/packages/code-combinators/test/Test/CodeCombinators/Common.hs
new file mode 100644
index 00000000..ad7b7175
--- /dev/null
+++ b/packages/code-combinators/test/Test/CodeCombinators/Common.hs
@@ -0,0 +1,28 @@
+module Test.CodeCombinators.Common where
+
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import qualified Language.Haskell.TH as TH
+import qualified Happy.Backend.CodeCombinators.Abstract()
+import Happy.Backend.CodeCombinators
+
+genFunName :: MonadGen m => m TH.Name
+genFunName = do
+  name_tail <- Gen.list (Range.linear 1 10) Gen.alphaNum
+  name_head <- Gen.lower
+  return $ mkName $ (name_head : name_tail) ++ "_"
+
+genClassName :: MonadGen m => m TH.Name
+genClassName = do
+  name_tail <- Gen.list (Range.linear 1 10) Gen.alphaNum
+  name_head <- Gen.upper
+  return $ mkName $ (name_head : name_tail) ++ "_"
+
+fullName :: TH.Name -> String
+fullName nm =
+  moduleName ++ TH.nameBase nm
+  where moduleName =
+          case TH.nameModule nm of
+            Just str -> str ++ "."
+            Nothing -> ""
diff --git a/packages/code-combinators/test/Test/CodeCombinators/GenDec.hs b/packages/code-combinators/test/Test/CodeCombinators/GenDec.hs
new file mode 100644
index 00000000..e6786eaa
--- /dev/null
+++ b/packages/code-combinators/test/Test/CodeCombinators/GenDec.hs
@@ -0,0 +1,76 @@
+module Test.CodeCombinators.GenDec where
+
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import qualified Language.Haskell.TH as TH
+import qualified Happy.Backend.CodeCombinators.Syntax as SnGen
+import Happy.Backend.CodeCombinators
+import Test.CodeCombinators.Common
+import Test.CodeCombinators.GenExp
+import Test.CodeCombinators.GenPat
+import Test.CodeCombinators.GenType
+
+genClause :: MonadGen m => Int -> m TH.Clause
+genClause pNumber = do
+    ps <- Gen.list (Range.linear pNumber pNumber) genPat
+    e <- genExp
+    ds <- genDecList
+    return $ clause ps e ds
+
+genSigD :: MonadGen m => m TH.Dec
+genSigD = do
+    nm <- genFunName
+    tp <- genType
+    return $ sigD nm tp
+
+genFunD :: MonadGen m => m TH.Dec
+genFunD = do
+    nm <- genFunName
+    pn <- Gen.int $ Range.linear 1 5
+    cls <- Gen.list (Range.linear 1 20) (genClause pn)
+    return $ funD nm cls
+
+genDecList :: MonadGen m => m [TH.Dec]
+genDecList =
+  Gen.recursive Gen.choice
+    [ Gen.list (Range.linear 1 5) genSigD ]
+    [ Gen.list (Range.linear 1 5) genFunD ]
+
+decListToString :: [TH.Dec] -> String
+decListToString ds = SnGen.renderDocDecs [decToDocDec <$> ds] ""
+
+decToDocDec :: TH.Dec -> SnGen.DocDec
+decToDocDec (TH.SigD nm tp) =
+    SnGen.sigD (SnGen.mkName $ fullName nm) $ typeToDocType tp
+
+decToDocDec (TH.FunD nm cls) =
+  SnGen.funD (SnGen.mkName $ fullName nm)
+    (clauseToDocClause <$> cls)
+
+decToDocDec _ = error "invalid dec"
+
+clauseToDocClause :: TH.Clause -> SnGen.DocClause
+clauseToDocClause (TH.Clause ps (TH.NormalB e) ds) =
+  SnGen.clause (patToDocPat <$> ps) (expToDocExp e) (decToDocDec <$> ds)
+
+clauseToDocClause c = error $ "invalid сlause" ++ show c
+
+deleteParensDecList :: [TH.Dec] -> [TH.Dec]
+deleteParensDecList = map deleteParensD
+
+deleteParensD :: TH.Dec -> TH.Dec
+deleteParensD (TH.SigD nm tp) =
+  TH.SigD nm $ deleteParensT tp
+
+deleteParensD (TH.FunD nm cls) =
+  TH.FunD nm $
+    deleteParensC <$> cls
+
+deleteParensD d = error $ "invalid dec" ++ show d
+
+deleteParensC :: TH.Clause -> TH.Clause
+deleteParensC (TH.Clause ps (TH.NormalB e) ds) =
+    TH.Clause (deleteParensP <$> ps) (TH.NormalB $ deleteParensE e) (deleteParensD <$> ds)
+
+deleteParensC c = error $ "invalid сlause" ++ show c
diff --git a/packages/code-combinators/test/Test/CodeCombinators/GenExp.hs b/packages/code-combinators/test/Test/CodeCombinators/GenExp.hs
new file mode 100644
index 00000000..486335a2
--- /dev/null
+++ b/packages/code-combinators/test/Test/CodeCombinators/GenExp.hs
@@ -0,0 +1,143 @@
+module Test.CodeCombinators.GenExp where
+
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import qualified Language.Haskell.TH as TH
+import qualified Happy.Backend.CodeCombinators.Syntax as SnGen
+import qualified Happy.Backend.CodeCombinators.Abstract()
+import Happy.Backend.CodeCombinators
+import Test.CodeCombinators.Common
+import Data.List
+
+genIntE :: MonadGen m => m TH.Exp
+genIntE = do
+  x <- Gen.int $ Range.linear minBound maxBound
+  return $ intE x
+
+genStringE :: MonadGen m => m TH.Exp
+genStringE = do
+  str <- Gen.list (Range.linear 0 20) Gen.latin1
+  return $ stringE $ delete '\n' str
+
+genConE :: MonadGen m => m TH.Exp
+genConE = do
+  conName <- genClassName
+  return $ TH.ConE conName
+
+genVarE :: MonadGen m => m TH.Exp
+genVarE = do
+  varName <- genFunName
+  return $ TH.VarE varName
+
+genAppE :: MonadGen m => m TH.Exp
+genAppE = do
+  e1 <- genExp
+  e2 <- genExp
+  return $ appE e1 e2
+
+genAppManyArgsE :: MonadGen m => m TH.Exp
+genAppManyArgsE = do
+  e <- genExp
+  es <- Gen.list (Range.linear 0 5) genExp
+  return $ appManyArgsE e es
+
+genTupE :: MonadGen m => m TH.Exp
+genTupE = do
+  es <- Gen.list (Range.linear 2 20) genExp
+  return $ tupE es
+
+genListE :: MonadGen m => m TH.Exp
+genListE = do
+  es <- Gen.list (Range.linear 0 20) genExp
+  return $ listE es
+
+genArithSeqE :: MonadGen m => m TH.Exp
+genArithSeqE = do
+  e1 <- genExp
+  e2 <- genExp
+  return $ TH.ArithSeqE $ TH.FromToR e1 e2
+
+genExp :: MonadGen m => m TH.Exp
+genExp =
+  Gen.recursive Gen.choice
+    [
+        genIntE
+      , genStringE
+      , genConE
+      , genVarE
+    ]
+    [
+        genAppE
+      , genTupE
+      , genListE
+      , genArithSeqE
+      , genAppManyArgsE
+    ]
+
+expToString :: TH.Exp -> String
+expToString e = SnGen.renderE (expToDocExp e) ""
+
+expToDocExp :: TH.Exp -> SnGen.DocExp
+expToDocExp (TH.LitE l) =
+  case l of
+    TH.StringL str -> SnGen.stringE str
+    TH.IntegerL num -> SnGen.intE $ fromIntegral num
+    _ -> error "invalid literal"
+
+expToDocExp (TH.ConE nm) =
+  SnGen.conE $ SnGen.mkName $ fullName nm
+
+expToDocExp (TH.VarE nm) =
+  SnGen.varE $ SnGen.mkName $ fullName nm
+
+expToDocExp (TH.AppE e1 e2) =
+  SnGen.appE (expToDocExp e1) (expToDocExp e2)
+
+expToDocExp (TH.ListE es) =
+  SnGen.listE $ map expToDocExp es
+
+expToDocExp (TH.TupE es) =
+  SnGen.tupE $ map (\(Just e) -> expToDocExp e) es
+
+expToDocExp (TH.ArithSeqE range) =
+  case range of
+    TH.FromToR e1 e2 ->
+      SnGen.arithSeqE $
+        SnGen.FromToR (expToDocExp e1) (expToDocExp e2)
+    _ ->
+       error "invalid range"
+
+expToDocExp _ = error "invalid exp"
+
+
+deleteParensE :: TH.Exp -> TH.Exp
+deleteParensE (TH.ParensE e) =
+  deleteParensE e
+
+deleteParensE (TH.LitE l) =
+  TH.LitE l
+
+deleteParensE (TH.ConE nm) =
+  TH.ConE nm
+
+deleteParensE (TH.VarE nm) =
+  TH.VarE nm
+
+deleteParensE (TH.AppE e1 e2) =
+ TH.AppE (deleteParensE e1) (deleteParensE e2)
+
+deleteParensE (TH.ListE es) =
+  TH.ListE $ map deleteParensE es
+
+deleteParensE (TH.TupE es) =
+  TH.TupE $ map (\(Just e) -> Just $ deleteParensE e) es
+
+deleteParensE (TH.ArithSeqE range) =
+  case range of
+    TH.FromToR e1 e2 ->
+      TH.ArithSeqE $ TH.FromToR (deleteParensE e1) (deleteParensE e2)
+    _ ->
+      error "invalid range"
+
+deleteParensE e = error $ "invalid exp" ++ show e
diff --git a/packages/code-combinators/test/Test/CodeCombinators/GenPat.hs b/packages/code-combinators/test/Test/CodeCombinators/GenPat.hs
new file mode 100644
index 00000000..3ad24803
--- /dev/null
+++ b/packages/code-combinators/test/Test/CodeCombinators/GenPat.hs
@@ -0,0 +1,106 @@
+module Test.CodeCombinators.GenPat where
+
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import qualified Language.Haskell.TH as TH
+import qualified Happy.Backend.CodeCombinators.Syntax as SnGen
+import qualified Happy.Backend.CodeCombinators.Abstract()
+import Happy.Backend.CodeCombinators
+import Test.CodeCombinators.Common
+import Data.List
+
+
+genLitP :: MonadGen m => m TH.Pat
+genLitP = do
+  x <- Gen.choice $
+         [
+            do
+            c <- Gen.latin1
+            return $ litP $ TH.CharL c
+          , do
+            s <- Gen.list (Range.linear 0 20) Gen.latin1
+            return $ litP $ TH.StringL $ delete '\n' s
+          , do
+            x <- Gen.int $ Range.linear minBound maxBound
+            return $ litP $ TH.IntegerL $ fromIntegral x
+         ]
+  return x
+
+genBoolP :: MonadGen m => m TH.Pat
+genBoolP = Gen.element [trueP, falseP]
+
+genVarP :: MonadGen m => m TH.Pat
+genVarP = do
+  varName <- genFunName
+  return $ varP varName
+
+genWildP :: MonadGen m => m TH.Pat
+genWildP = return wildP
+
+genConP :: MonadGen m => m TH.Pat
+genConP = do
+  conName <- genClassName
+  ps <- Gen.list (Range.linear 2 20) genPat
+  return $ conP conName ps
+
+genTupP :: MonadGen m => m TH.Pat
+genTupP = do
+  ps <- Gen.list (Range.linear 2 20) genPat
+  return $ tupP ps
+
+genPat :: MonadGen m => m TH.Pat
+genPat =
+  Gen.recursive Gen.choice
+    [
+        genLitP
+      , genBoolP
+      , genVarP
+      , genWildP
+    ]
+    [
+        genConP
+      , genTupP
+    ]
+
+patToString :: TH.Pat -> String
+patToString p = SnGen.renderP (patToDocPat p) ""
+
+patToDocPat :: TH.Pat -> SnGen.DocPat
+patToDocPat (TH.LitP p) = SnGen.litP p
+
+patToDocPat (TH.ConP nm ps) =
+  SnGen.conP
+    (SnGen.mkName $ fullName nm)
+    (map patToDocPat ps)
+
+patToDocPat (TH.VarP nm) =
+  SnGen.varP $ SnGen.mkName $ fullName nm
+
+patToDocPat (TH.TupP ps) =
+  SnGen.tupP $ map patToDocPat ps
+
+patToDocPat TH.WildP =
+  SnGen.wildP
+
+patToDocPat _ = error "invalid pat"
+
+
+deleteParensP :: TH.Pat -> TH.Pat
+deleteParensP (TH.ParensP p) = deleteParensP p
+
+deleteParensP (TH.LitP p) = TH.LitP p
+
+deleteParensP (TH.ConP nm ps) =
+  TH.ConP nm $ map deleteParensP ps
+
+deleteParensP (TH.VarP nm) =
+  TH.VarP nm
+
+deleteParensP (TH.TupP ps) =
+  TH.TupP $ map deleteParensP ps
+
+deleteParensP TH.WildP =
+  TH.WildP
+
+deleteParensP p = error $ "invalid exp" ++ show p
diff --git a/packages/code-combinators/test/Test/CodeCombinators/GenType.hs b/packages/code-combinators/test/Test/CodeCombinators/GenType.hs
new file mode 100644
index 00000000..a4286719
--- /dev/null
+++ b/packages/code-combinators/test/Test/CodeCombinators/GenType.hs
@@ -0,0 +1,79 @@
+module Test.CodeCombinators.GenType where
+
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import qualified Language.Haskell.TH as TH
+import qualified Happy.Backend.CodeCombinators.Syntax as SnGen
+import qualified Happy.Backend.CodeCombinators.Abstract()
+import Happy.Backend.CodeCombinators
+import Test.CodeCombinators.Common
+
+genIntT :: MonadGen m => m TH.Type
+genIntT = return $ intT
+
+genConT :: MonadGen m => m TH.Type
+genConT = do
+  conName <- genClassName
+  return $ conT conName
+
+genVarT :: MonadGen m => m TH.Type
+genVarT = do
+  varName <- genFunName
+  return $ varT varName
+
+genAppT :: MonadGen m => m TH.Type
+genAppT = do
+  t1 <- genType
+  t2 <- genType
+  return $ appT t1 t2
+
+genAppManyArgsT :: MonadGen m => m TH.Type
+genAppManyArgsT = do
+  t <- genType
+  ts <- Gen.list (Range.linear 0 5) genType
+  return $ appManyArgsT t ts
+
+genType :: MonadGen m => m TH.Type
+genType =
+  Gen.recursive Gen.choice
+    [
+        genIntT
+      , genConT
+      , genVarT
+    ]
+    [
+        genAppT
+      , genAppManyArgsT
+    ]
+
+typeToString :: TH.Type -> String
+typeToString e = SnGen.renderT (typeToDocType e) ""
+
+typeToDocType :: TH.Type -> SnGen.DocType
+typeToDocType (TH.ConT nm) =
+  SnGen.conT $ SnGen.mkName $ fullName nm
+
+typeToDocType (TH.VarT nm) =
+  SnGen.varT $ SnGen.mkName $ fullName nm
+
+typeToDocType (TH.AppT e1 e2) =
+  SnGen.appT (typeToDocType e1) (typeToDocType e2)
+
+typeToDocType _ = error "invalid type"
+
+
+deleteParensT :: TH.Type -> TH.Type
+deleteParensT (TH.ParensT t) =
+  deleteParensT t
+
+deleteParensT (TH.ConT nm) =
+  TH.ConT nm
+
+deleteParensT (TH.VarT nm) =
+  TH.VarT nm
+
+deleteParensT (TH.AppT t1 t2) =
+ TH.AppT (deleteParensT t1) (deleteParensT t2)
+
+deleteParensT t = error $ "invalid type" ++ show t