diff --git a/CHANGES.md b/CHANGES.md
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,16 @@
+0.8.0.0
+=======
+
+This release contains breaking changes. The number of transitive dependencies
+has been reduced significantly.
+
+-   Switched parser to `megaparsec`. `trifecta` and `parsers` bring too many
+    dependencies with them.
+-   Drop support for `wl-pprint`. Only `ansi-wl-pprint` is supported now.
+-   Drop dependency on `lens`. Lenses for fields of the AST elements are still
+    provided but prisms are not. Use `Control.Lens.makePrisms` to derive your
+    own if needed.
+
 0.7.0.1
 =======
 
diff --git a/Language/Thrift/Internal/Types.hs b/Language/Thrift/Internal/Types.hs
--- a/Language/Thrift/Internal/Types.hs
+++ b/Language/Thrift/Internal/Types.hs
@@ -1,8 +1,10 @@
 {-# LANGUAGE DeriveDataTypeable     #-}
+{-# LANGUAGE DeriveFunctor          #-}
 {-# LANGUAGE DeriveGeneric          #-}
 {-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE RankNTypes             #-}
 module Language.Thrift.Internal.Types
     (
     -- * AST
@@ -12,8 +14,6 @@
     , definitions
 
     , Header(..)
-    , _Include
-    , _Namespace
 
     , Include(..)
     , path
@@ -22,9 +22,6 @@
     , language
 
     , Definition(..)
-    , _Const
-    , _Service
-    , _Type
 
     , Const(..)
     , Service(..)
@@ -32,12 +29,6 @@
     , extends
 
     , Type(..)
-    , _Typedef
-    , _Enum
-    , _Struct
-    , _Union
-    , _Exception
-    , _Senum
 
     , Typedef(..)
     , targetType
@@ -49,8 +40,6 @@
     , Senum(..)
 
     , FieldRequiredness(..)
-    , _Required
-    , _Optional
 
     , Field(..)
     , identifier
@@ -60,27 +49,8 @@
     , EnumDef(..)
 
     , ConstValue(..)
-    , _ConstInt
-    , _ConstFloat
-    , _ConstLiteral
-    , _ConstIdentifier
-    , _ConstList
-    , _ConstMap
 
     , TypeReference(..)
-    , _DefinedType
-    , _StringType
-    , _BinaryType
-    , _SListType
-    , _BoolType
-    , _ByteType
-    , _I16Type
-    , _I32Type
-    , _I64Type
-    , _DoubleType
-    , _MapType
-    , _SetType
-    , _ListType
 
     , Function(..)
     , oneWay
@@ -103,20 +73,33 @@
     , HasValueType(..)
     ) where
 
-import Control.Lens (Lens', Prism', lens, prism', set, view)
-import Data.Data    (Data, Typeable)
-import Data.Text    (Text)
-import GHC.Generics (Generic)
-import Prelude      hiding (Enum)
+import Data.Data             (Data, Typeable)
+import Data.Functor.Identity (Identity (..))
+import Data.Text             (Text)
+import GHC.Generics          (Generic)
+import Prelude               hiding (Enum)
 
+import qualified Control.Applicative as A
+
+type Lens s a = forall f. Functor f => (a -> f a) -> s -> f s
+
+lens :: (s -> a) -> (s -> a -> s) -> Lens s a
+lens getter setter f s = setter s `fmap` f (getter s)
+
+set :: Lens s a -> a -> s -> s
+set l a = runIdentity . l (\_ -> Identity a)
+
+view :: Lens s a -> s -> a
+view l = A.getConst . l A.Const
+
 class HasSrcAnnot t where
-    srcAnnot :: Lens' (t a) a
+    srcAnnot :: Lens (t a) a
 
 class HasName t where
-    name :: Lens' t Text
+    name :: Lens t Text
 
 class HasValue s a | s -> a where
-    value :: Lens' s a
+    value :: Lens s a
 
 -- | Type annoations may be added in various places in the form,
 --
@@ -139,7 +122,7 @@
     value = lens typeAnnotationValue (\s a -> s { typeAnnotationValue = a })
 
 class HasAnnotations t where
-    annotations :: Lens' t [TypeAnnotation]
+    annotations :: Lens t [TypeAnnotation]
 
 -- | Docstrings are Javadoc-style comments attached various defined objects.
 --
@@ -150,7 +133,7 @@
 type Docstring = Maybe Text
 
 class HasDocstring t where
-    docstring :: Lens' t Docstring
+    docstring :: Lens t Docstring
 
 -- | A constant literal value in the IDL. Only a few basic types, lists, and
 -- maps can be presented in Thrift files as literals.
@@ -170,43 +153,7 @@
     | ConstMap [(ConstValue srcAnnot, ConstValue srcAnnot)] srcAnnot
     -- ^ A literal list containing other constant values.
     -- @{"hellO": 1, "world": 2}@
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
-
-_ConstInt :: Prism' (ConstValue a) (Integer, a)
-_ConstInt = prism' (uncurry ConstInt) $ \c ->
-    case c of
-        ConstInt v a -> Just (v, a)
-        _            -> Nothing
-
-_ConstFloat :: Prism' (ConstValue a) (Double, a)
-_ConstFloat = prism' (uncurry ConstFloat) $ \c ->
-    case c of
-        ConstFloat v a -> Just (v, a)
-        _              -> Nothing
-
-_ConstLiteral :: Prism' (ConstValue a) (Text, a)
-_ConstLiteral = prism' (uncurry ConstLiteral) $ \c ->
-    case c of
-        ConstLiteral v a -> Just (v, a)
-        _                -> Nothing
-
-_ConstIdentifier :: Prism' (ConstValue a) (Text, a)
-_ConstIdentifier = prism' (uncurry ConstIdentifier) $ \c ->
-    case c of
-        ConstIdentifier v a -> Just (v, a)
-        _                   -> Nothing
-
-_ConstList :: Prism' (ConstValue a) ([ConstValue a], a)
-_ConstList = prism' (uncurry ConstList) $ \c ->
-    case c of
-        ConstList v a -> Just (v, a)
-        _             -> Nothing
-
-_ConstMap :: Prism' (ConstValue a) ([(ConstValue a, ConstValue a)], a)
-_ConstMap = prism' (uncurry ConstMap) $ \c ->
-    case c of
-        ConstMap v a -> Just (v, a)
-        _            -> Nothing
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasSrcAnnot ConstValue where
     srcAnnot = lens getter setter
@@ -260,85 +207,7 @@
     -- ^ @set\<baz\>@ and annotations.
     | ListType (TypeReference srcAnnot) [TypeAnnotation] srcAnnot
     -- ^ @list\<qux\>@ and annotations.
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
-
-_DefinedType :: Prism' (TypeReference a) (Text, a)
-_DefinedType = prism' (uncurry DefinedType) $ \r ->
-    case r of
-        DefinedType t a -> Just (t, a)
-        _               -> Nothing
-
-_StringType :: Prism' (TypeReference a) ([TypeAnnotation], a)
-_StringType = prism' (uncurry StringType) $ \r ->
-    case r of
-        StringType t a -> Just (t, a)
-        _              -> Nothing
-
-_BinaryType :: Prism' (TypeReference a) ([TypeAnnotation], a)
-_BinaryType = prism' (uncurry BinaryType) $ \r ->
-    case r of
-        BinaryType t a -> Just (t, a)
-        _              -> Nothing
-
-_SListType :: Prism' (TypeReference a) ([TypeAnnotation], a)
-_SListType = prism' (uncurry SListType) $ \r ->
-    case r of
-        SListType t a -> Just (t, a)
-        _             -> Nothing
-
-_BoolType :: Prism' (TypeReference a) ([TypeAnnotation], a)
-_BoolType = prism' (uncurry BoolType) $ \r ->
-    case r of
-        BoolType t a -> Just (t, a)
-        _            -> Nothing
-
-_ByteType :: Prism' (TypeReference a) ([TypeAnnotation], a)
-_ByteType = prism' (uncurry ByteType) $ \r ->
-    case r of
-        ByteType t a -> Just (t, a)
-        _            -> Nothing
-
-_I16Type :: Prism' (TypeReference a) ([TypeAnnotation], a)
-_I16Type = prism' (uncurry I16Type) $ \r ->
-    case r of
-        I16Type t a -> Just (t, a)
-        _           -> Nothing
-
-_I32Type :: Prism' (TypeReference a) ([TypeAnnotation], a)
-_I32Type = prism' (uncurry I32Type) $ \r ->
-    case r of
-        I32Type t a -> Just (t, a)
-        _           -> Nothing
-
-_I64Type :: Prism' (TypeReference a) ([TypeAnnotation], a)
-_I64Type = prism' (uncurry I64Type) $ \r ->
-    case r of
-        I64Type t a -> Just (t, a)
-        _           -> Nothing
-
-_DoubleType :: Prism' (TypeReference a) ([TypeAnnotation], a)
-_DoubleType = prism' (uncurry DoubleType) $ \r ->
-    case r of
-        DoubleType t a -> Just (t, a)
-        _              -> Nothing
-
-_MapType :: Prism' (TypeReference a) (TypeReference a, TypeReference a, [TypeAnnotation], a)
-_MapType = prism' (\(k, v, t, a) -> MapType k v t a) $ \r ->
-    case r of
-        MapType k v t a -> Just (k, v, t, a)
-        _               -> Nothing
-
-_SetType :: Prism' (TypeReference a) (TypeReference a, [TypeAnnotation], a)
-_SetType = prism' (\(v, t, a) -> SetType v t a) $ \r ->
-    case r of
-        SetType v t a -> Just (v, t, a)
-        _             -> Nothing
-
-_ListType :: Prism' (TypeReference a) (TypeReference a, [TypeAnnotation], a)
-_ListType = prism' (\(v, t, a) -> ListType v t a) $ \r ->
-    case r of
-        ListType v t a -> Just (v, t, a)
-        _              -> Nothing
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasSrcAnnot TypeReference where
     srcAnnot = lens getter setter
@@ -372,7 +241,7 @@
         setter (ListType  t x _) a = ListType  t x a
 
 class HasValueType t where
-    valueType :: Lens' (t a) (TypeReference a)
+    valueType :: Lens (t a) (TypeReference a)
 
 -- | Whether a field is required or optional.
 data FieldRequiredness
@@ -380,18 +249,6 @@
     | Optional -- ^ The field is @optional@.
   deriving (Show, Ord, Eq, Data, Typeable, Generic)
 
-_Required :: Prism' FieldRequiredness ()
-_Required = prism' (\() -> Required) $ \r ->
-    case r of
-        Required -> Just ()
-        _        -> Nothing
-
-_Optional :: Prism' FieldRequiredness ()
-_Optional = prism' (\() -> Optional) $ \r ->
-    case r of
-        Optional -> Just ()
-        _        -> Nothing
-
 -- | A field inside a struct, exception, or function parameters list.
 data Field srcAnnot = Field
     { fieldIdentifier   :: Maybe Integer
@@ -417,15 +274,15 @@
     -- ^ Documentation.
     , fieldSrcAnnot     :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
-identifier :: Lens' (Field a) (Maybe Integer)
+identifier :: Lens (Field a) (Maybe Integer)
 identifier = lens fieldIdentifier (\s a -> s { fieldIdentifier = a })
 
-requiredness :: Lens' (Field a) (Maybe FieldRequiredness)
+requiredness :: Lens (Field a) (Maybe FieldRequiredness)
 requiredness = lens fieldRequiredness (\s a -> s { fieldRequiredness = a })
 
-defaultValue :: Lens' (Field a) (Maybe (ConstValue a))
+defaultValue :: Lens (Field a) (Maybe (ConstValue a))
 defaultValue = lens fieldDefaultValue (\s a -> s { fieldDefaultValue = a })
 
 instance HasName (Field a) where
@@ -444,7 +301,7 @@
     annotations = lens fieldAnnotations (\s a -> s { fieldAnnotations = a })
 
 class HasFields t where
-    fields :: Lens' (t a) [Field a]
+    fields :: Lens (t a) [Field a]
 
 -- | A function defined inside a service.
 data Function srcAnnot = Function
@@ -465,18 +322,18 @@
     -- ^ Documentation.
     , functionSrcAnnot    :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
-oneWay :: Lens' (Function a) Bool
+oneWay :: Lens (Function a) Bool
 oneWay = lens functionOneWay (\s a -> s { functionOneWay = a })
 
-returnType :: Lens' (Function a) (Maybe (TypeReference a))
+returnType :: Lens (Function a) (Maybe (TypeReference a))
 returnType = lens functionReturnType (\s a -> s { functionReturnType = a })
 
-parameters :: Lens' (Function a) [Field a]
+parameters :: Lens (Function a) [Field a]
 parameters = lens functionParameters (\s a -> s { functionParameters = a })
 
-exceptions :: Lens' (Function a) (Maybe [Field a])
+exceptions :: Lens (Function a) (Maybe [Field a])
 exceptions = lens functionExceptions (\s a -> s { functionExceptions = a })
 
 instance HasName (Function a) where
@@ -509,12 +366,12 @@
     -- ^ Documentation.
     , serviceSrcAnnot    :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
-functions :: Lens' (Service a) [Function a]
+functions :: Lens (Service a) [Function a]
 functions = lens serviceFunctions (\s a -> s { serviceFunctions = a })
 
-extends :: Lens' (Service a) (Maybe Text)
+extends :: Lens (Service a) (Maybe Text)
 extends = lens serviceExtends (\s a -> s { serviceExtends = a })
 
 instance HasName (Service a) where
@@ -543,7 +400,7 @@
     -- ^ Documentation.
     , constSrcAnnot  :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasValue (Const a) (ConstValue a) where
     value = lens constValue (\s a -> s { constValue = a })
@@ -574,9 +431,9 @@
     -- ^ Documentation.
     , typedefSrcAnnot    :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
-targetType :: Lens' (Typedef a) (TypeReference a)
+targetType :: Lens (Typedef a) (TypeReference a)
 targetType = lens typedefTargetType (\s a -> s { typedefTargetType = a })
 
 instance HasName (Typedef a) where
@@ -603,7 +460,7 @@
     -- ^ Documentation
     , enumDefSrcAnnot    :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasValue (EnumDef a) (Maybe Integer) where
     value = lens enumDefValue (\s a -> s { enumDefValue = a })
@@ -636,10 +493,10 @@
     -- ^ Documentation.
     , enumSrcAnnot    :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 class HasValues s a | s -> a where
-    values :: Lens' s a
+    values :: Lens s a
 
 instance HasValues (Enum a) [EnumDef a] where
     values = lens enumValues (\s a -> s { enumValues = a })
@@ -672,7 +529,7 @@
     -- ^ Documentation.
     , structSrcAnnot    :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasName (Struct a) where
     name = lens structName (\s a -> s { structName = a })
@@ -706,7 +563,7 @@
     -- ^ Documentation.
     , unionSrcAnnot    :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasName (Union a) where
     name = lens unionName (\s a -> s { unionName = a })
@@ -740,7 +597,7 @@
     -- ^ Documentation.
     , exceptionSrcAnnot    :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasName (Exception a) where
     name = lens exceptionName (\s a -> s { exceptionName = a })
@@ -768,7 +625,7 @@
     -- ^ Documentation.
     , senumSrcAnnot    :: srcAnnot
     }
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasValues (Senum a) [Text] where
     values = lens senumValues (\s a -> s { senumValues = a })
@@ -799,7 +656,7 @@
       ExceptionType (Exception srcAnnot)
     | -- | @senum@
       SenumType (Senum srcAnnot)
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasName (Type a) where
     name = lens getter setter
@@ -835,43 +692,6 @@
         setter (ExceptionType t) a = ExceptionType $ set srcAnnot a t
         setter (SenumType     t) a = SenumType     $ set srcAnnot a t
 
-_Typedef :: Prism' (Type ann) (Typedef ann)
-_Typedef = prism' TypedefType $ \t ->
-    case t of
-        TypedefType a -> Just a
-        _             -> Nothing
-
-_Enum :: Prism' (Type ann) (Enum ann)
-_Enum = prism' EnumType $ \t ->
-    case t of
-        EnumType a -> Just a
-        _          -> Nothing
-
-_Struct :: Prism' (Type ann) (Struct ann)
-_Struct = prism' StructType $ \t ->
-    case t of
-        StructType a -> Just a
-        _            -> Nothing
-
-_Union :: Prism' (Type ann) (Union ann)
-_Union = prism' UnionType $ \t ->
-    case t of
-        UnionType a -> Just a
-        _           -> Nothing
-
-_Exception :: Prism' (Type ann) (Exception ann)
-_Exception = prism' ExceptionType $ \t ->
-    case t of
-        ExceptionType a -> Just a
-        _               -> Nothing
-
-_Senum :: Prism' (Type ann) (Senum ann)
-_Senum = prism' SenumType $ \t ->
-    case t of
-        SenumType a -> Just a
-        _           -> Nothing
-
-
 -- | A definition either consists of new constants, new types, or new
 -- services.
 data Definition srcAnnot
@@ -881,7 +701,7 @@
       TypeDefinition (Type srcAnnot)
     | -- | A service definition.
       ServiceDefinition (Service srcAnnot)
-  deriving (Show, Ord, Eq, Data, Typeable, Generic)
+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 instance HasName (Definition a) where
     name = lens getter setter
@@ -906,25 +726,6 @@
         setter (ServiceDefinition d) a = ServiceDefinition $ set srcAnnot a d
 
 
-_Const :: Prism' (Definition ann) (Const ann)
-_Const = prism' ConstDefinition $ \def ->
-    case def of
-        ConstDefinition c -> Just c
-        _                 -> Nothing
-
-_Type :: Prism' (Definition ann) (Type ann)
-_Type = prism' TypeDefinition $ \def ->
-    case def of
-        TypeDefinition c -> Just c
-        _                 -> Nothing
-
-_Service :: Prism' (Definition ann) (Service ann)
-_Service = prism' ServiceDefinition $ \def ->
-    case def of
-        ServiceDefinition c -> Just c
-        _                 -> Nothing
-
-
 -- | Namespace directives allows control of the namespace or package
 -- name used by the generated code for certain languages.
 --
@@ -938,9 +739,9 @@
     -- language.
     , namespaceSrcAnnot :: srcAnnot
     }
-    deriving (Show, Ord, Eq, Data, Typeable, Generic)
+    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
-language :: Lens' (Namespace a) Text
+language :: Lens (Namespace a) Text
 language = lens namespaceLanguage (\s a -> s { namespaceLanguage = a })
 
 instance HasName (Namespace a) where
@@ -960,9 +761,9 @@
     -- ^ Path to the included file.
     , includeSrcAnnot :: srcAnnot
     }
-    deriving (Show, Ord, Eq, Data, Typeable, Generic)
+    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
-path :: Lens' (Include a) Text
+path :: Lens (Include a) Text
 path = lens includePath (\s a -> s { includePath = a })
 
 instance HasSrcAnnot Include where
@@ -974,20 +775,7 @@
       HeaderInclude (Include srcAnnot)
     | -- | A @namespace@ specifier.
       HeaderNamespace (Namespace srcAnnot)
-    deriving (Show, Ord, Eq, Data, Typeable, Generic)
-
-_Include :: Prism' (Header ann) (Include ann)
-_Include = prism' HeaderInclude $ \h ->
-    case h of
-        HeaderInclude inc -> Just inc
-        _                 -> Nothing
-
-_Namespace :: Prism' (Header ann) (Namespace ann)
-_Namespace = prism' HeaderNamespace $ \h ->
-    case h of
-        HeaderNamespace ns -> Just ns
-        _                  -> Nothing
-
+    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
 -- | A program represents a single Thrift document.
 data Program srcAnnot = Program
@@ -996,10 +784,10 @@
     , programDefinitions :: [Definition srcAnnot]
     -- ^ Types and services defined in the document.
     }
-    deriving (Show, Ord, Eq, Data, Typeable, Generic)
+    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
 
-headers :: Lens' (Program a) [Header a]
+headers :: Lens (Program a) [Header a]
 headers = lens programHeaders (\s a -> s { programHeaders = a })
 
-definitions :: Lens' (Program a) [Definition a]
+definitions :: Lens (Program a) [Definition a]
 definitions = lens programDefinitions (\s a -> s { programDefinitions = a })
diff --git a/Language/Thrift/Parser.hs b/Language/Thrift/Parser.hs
--- a/Language/Thrift/Parser.hs
+++ b/Language/Thrift/Parser.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
 -- |
 -- Module      :  Language.Thrift.Parser
 -- Copyright   :  (c) Abhinav Gupta 2015
@@ -24,7 +25,9 @@
 -- for example, you could define a string value for an int constant.
 --
 module Language.Thrift.Parser
-    ( thriftIDL
+    ( parseFromFile
+    , parse
+    , thriftIDL
 
     -- * Components
 
@@ -49,247 +52,302 @@
     , typeReference
     , constantValue
 
+    , docstring
+
     -- * Parser
 
-    , ThriftParser
-    , runThriftParser
+    , Parser
+    , runParser
+    , whiteSpace
     ) where
 
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Trans.Class  (lift)
-import Control.Monad.Trans.Reader (ReaderT)
-import Control.Monad.Trans.State  (StateT)
-import Data.Text                  (Text)
-import Text.Parser.Char
-import Text.Parser.Combinators
-import Text.Parser.Token
-import Text.Parser.Token.Style    (emptyIdents)
+import Control.Monad.Trans.State (StateT)
+import Data.Text                 (Text)
 
-import qualified Control.Monad.Trans.Reader as Reader
-import qualified Control.Monad.Trans.State  as State
-import qualified Data.Text                  as Text
+import qualified Control.Monad.Trans.State as State
+import qualified Data.Text                 as Text
+import qualified Text.Megaparsec           as P
+import qualified Text.Megaparsec.Lexer     as PL
 
 import qualified Language.Thrift.Types as T
 
+-- | Keeps track of the last docstring seen by the system so that we can
+-- attach it to entities.
+data State = State
+    { stateDocstring :: T.Docstring
+    }
+    deriving (Show, Eq)
 
--- | Get a top level parser that is able to parse full Thrift documents.
---
--- Entities defined in the IDL are annotated with @n@ values (determined by
--- executing @p n@ before the parser for the entity is executed).
---
--- Usage with Trifecta to get entities tagged with location information (see
--- also, 'Language.Thrift.Parser.Trifecta.thriftIDL'):
---
--- > Trifecta.parseFromFile (thriftIDL Trifecta.position) "service.thrift"
---
--- Usage with Attoparsec without any annotations:
---
--- > Attoparsec.parse (thriftIDL (return ())) document
---
-thriftIDL :: (MonadPlus p, TokenParsing p) => p n -> p (T.Program n)
-thriftIDL getAnnot = runThriftParser getAnnot program
+-- | Underlying Parser type.
+type Parser s = StateT State (P.Parsec s)
 
+-- | Evaluates the underlying parser with a default state and get the Megaparsec
+-- parser.
+runParser :: Parser s a -> P.Parsec s a
+runParser p = State.evalStateT p (State Nothing)
 
--- | Keeps track of the last docstring seen by the system so that we can
--- attach it to entities.
-newtype ParserState = ParserState
-  { parserLastDocstring :: T.Docstring
-  } deriving (Show, Ord, Eq)
+-- | Parses the Thrift file at the given path.
+parseFromFile :: FilePath -> IO (Either P.ParseError (T.Program P.SourcePos))
+parseFromFile =
+    P.parseFromFile (thriftIDL :: P.Parsec Text (T.Program P.SourcePos))
 
--- | The ThriftParser wraps another parser @p@ with some extra state. It also
--- allows injecting a configurable action @(p n)@ which produces annotations
--- that will be attached to entities in the Thrift file. See 'thriftIDLParser'
--- for an example.
-newtype ThriftParser p n a =
-        ThriftParser (StateT ParserState (ReaderT (p n) p) a)
-    deriving
-      ( Functor
-      , Applicative
-      , Alternative
-      , Monad
-      , MonadPlus
-      , Parsing
-      , CharParsing
-      )
+-- | @parse name contents@ parses the contents of a Thrift document with name
+-- @name@ held in @contents@.
+parse
+    :: P.Stream s Char
+    => FilePath -> s -> Either P.ParseError (T.Program P.SourcePos)
+parse = P.parse thriftIDL
 
--- | Returns the last docstring recorded by the system and clears it from the
--- parser state.
-lastDocstring :: Monad p => ThriftParser p n T.Docstring
-lastDocstring = ThriftParser $ do
-    s <- State.gets parserLastDocstring
-    State.put (ParserState Nothing)
+-- | Megaparsec parser that is able to parse full Thrift documents.
+thriftIDL :: P.Stream s Char => P.Parsec s (T.Program P.SourcePos)
+thriftIDL = runParser program
+
+
+clearDocstring :: Parser s ()
+clearDocstring = State.modify' (\s -> s { stateDocstring = Nothing })
+
+
+-- | Returns the last docstring recorded by the parser and forgets about it.
+lastDocstring :: Parser s T.Docstring
+lastDocstring = do
+    s <- State.gets stateDocstring
+    clearDocstring
     return s
 
--- | Get an exeecutable parser from the given ThriftParser.
-runThriftParser
-    :: (MonadPlus p, TokenParsing p)
-    => p n
-    -- ^ How to get annotations from the underlying parser. If this is not
-    -- something you need to use, make it @return ()@ and generated types will
-    -- be annotated with @()@.
-    -> ThriftParser p n a
-    -> p a
-runThriftParser getAnnot (ThriftParser p) =
-    Reader.runReaderT (State.evalStateT p (ParserState Nothing)) getAnnot
+-- | Optional whitespace.
+whiteSpace :: P.Stream s Char => Parser s ()
+whiteSpace = someSpace <|> pure ()
 
+-- | Required whitespace.
+someSpace :: P.Stream s Char => Parser s ()
+someSpace = P.skipSome $ readDocstring <|> skipComments <|> skipSpace
+  where
+    readDocstring = do
+        s <- docstring
+        unless (Text.null s) $
+            State.modify' (\st -> st { stateDocstring = Just s})
 
-instance
-  (TokenParsing p, MonadPlus p) => TokenParsing (ThriftParser p n) where
-    -- Docstring parsing works by cheating. We define docstrings as
-    -- whitespace, but we record it when we move over it. If we run into
-    -- another newline or other comments after seeing the docstring's "*/\n",
-    -- we clear the docstring out because it's most likely not attached to the
-    -- entity that follows. So for docstrings to be attached, there must be a
-    -- single newline between "*/" and the entity.
-    someSpace = skipSome $ readDocstring <|> skipComments <|> skipSpace
+    skipSpace = P.choice
+      [ P.newline *> clearDocstring
+      , P.skipSome P.spaceChar
+      ]
+
+    skipComments = P.choice
+        [ P.char '#'            *> skipLine
+        , P.try (P.string "//") *> skipLine
+        , P.try (P.string "/*") *> skipCStyleComment
+        ] *> clearDocstring
+
+    skipLine = void P.eol <|> P.eof <|> (P.anyChar *> skipLine)
+
+    skipCStyleComment = P.choice
+      [ P.try (P.string "*/")      *> pure ()
+      , P.skipSome (P.noneOf "/*") *> skipCStyleComment
+      , P.oneOf "/*"               *> skipCStyleComment
+      ]
+
+-- | @p `skipUpTo` n@ skips @p@ @n@ times or until @p@ stops matching --
+-- whichever comes first.
+skipUpTo :: P.Stream s Char => Parser s a -> Int -> Parser s ()
+skipUpTo p = loop
+  where
+    loop 0 = return ()
+    loop n =
+        ( do
+            void $ P.try p
+            loop $! n - 1
+        ) <|> return ()
+
+hspace :: P.Stream s Char => Parser s ()
+hspace = void $ P.oneOf " \t"
+
+-- | A javadoc-style docstring.
+--
+-- > /**
+-- >  * foo
+-- >  */
+--
+-- This parses attempts to preserve indentation inside the docstring while
+-- getting rid of the aligned @*@s (if any) and any other preceding space.
+--
+docstring :: P.Stream s Char => Parser s Text
+docstring = do
+    P.try (P.string "/**") >> P.skipMany hspace
+    indent <- P.sourceColumn <$> P.getPosition
+    isNewLine <- maybeEOL
+    chunks <- loop isNewLine (indent - 1) []
+    return $! Text.intercalate "\n" chunks
+  where
+    maybeEOL = (P.eol >> return True) <|> return False
+
+    commentChar =
+        P.noneOf "*\r\n" <|>
+        P.try (P.char '*' <* P.notFollowedBy (P.char '/'))
+
+    loop shouldDedent maxDedent chunks = do
+        when shouldDedent $
+            hspace `skipUpTo` maxDedent
+        finishComment <|> readDocLine
       where
-        skipSpace = choice [
-            newline *> clearDocstring
-          , ThriftParser someSpace
-          ]
+        finishComment = do
+            P.try (P.skipMany hspace <* P.string "*/")
+            void $ optional P.spaceChar
+            return $! reverse chunks
+        readDocLine = do
+            -- Lines could have aligned *s at the start.
+            --
+            --      /**
+            --       * foo
+            --       * bar
+            --       */
+            --
+            -- But only if we dedented. If we didn't, that's possibly because,
+            --
+            --      /** foo [..]
+            --
+            -- So if foo starts with "*", we don't want to drop that.
+            when shouldDedent . void $
+                optional $ P.try (P.char '*' >> optional hspace)
 
-        skipComments = choice [
-              char '#'   *> skipLine
-            , text "//"  *> skipLine
-            , text "/*"  *> skipCStyleComment
-            ] *> clearDocstring
-        skipLine = skipMany (satisfy (/= '\n')) <* newline
-        skipCStyleComment = choice [
-            text "*/"              *> pure ()
-          , skipSome (noneOf "/*") *> skipCStyleComment
-          , oneOf "/*"             *> skipCStyleComment
-          ]
+            line <- Text.pack <$> P.many commentChar
 
-        -- TODO this is really ugly. use some sort of docstring parser instead
-        clearDocstring = ThriftParser $ State.put (ParserState Nothing)
-        readDocstring = text "/**" *> loop []
-          where
-            saveDocstring s = unless (Text.null s') $
-                ThriftParser . State.put . ParserState . Just $ s'
-              where
-                s' = sanitizeDocstring s
-            loop chunks = choice [
-                text "*/" *> optional (newline <|> space) *>
-                saveDocstring (Text.strip . Text.concat $ reverse chunks)
-              , Text.pack      <$> some (noneOf "/*") >>= loop . (:chunks)
-              , Text.singleton <$>        oneOf "/*"  >>= loop . (:chunks)
-              ]
-            sanitizeDocstring :: Text -> Text
-            sanitizeDocstring =
-                Text.intercalate "\n"
-              . map (Text.dropWhile ignore)
-              . Text.lines
-              where ignore c = c == '*' || c == ' '
+            -- This line most likely ends with a newline but if it's the last
+            -- one, it could also be "foo */"
+            void (optional hspace >> maybeEOL)
 
+            loop True maxDedent (line:chunks)
 
--- | Type of identifiers allowed by Thrift.
-idStyle
-    :: forall p n. (TokenParsing p, MonadPlus p)
-    => IdentifierStyle (ThriftParser p n)
-idStyle = (emptyIdents :: IdentifierStyle (ThriftParser p n))
-    { _styleStart = letter <|> char '_'
-    , _styleLetter = alphaNum <|> oneOf "_."
-    }
 
+symbolic :: P.Stream s Char => Char -> Parser s ()
+symbolic c = void $ PL.symbol whiteSpace [c]
 
--- | Constructor for reserved keywords.
-reserved :: (TokenParsing p, MonadPlus p) => Text -> ThriftParser p n ()
-reserved = reserveText idStyle
+token :: P.Stream s Char => Parser s a -> Parser s a
+token = PL.lexeme whiteSpace
 
+braces, angles, parens :: P.Stream s Char => Parser s a -> Parser s a
 
--- | Top-level parser to parse complete Thrift documents.
-program :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Program n)
-program = whiteSpace >>
-    T.Program
-        <$> many (header     <* optionalSep)
-        <*> many (definition <* optionalSep)
-        <*  eof
+braces = P.between (symbolic '{') (symbolic '}')
+angles = P.between (symbolic '<') (symbolic '>')
+parens = P.between (symbolic '(') (symbolic ')')
 
+comma, semi, colon, equals :: P.Stream s Char => Parser s ()
 
+comma  = symbolic ','
+semi   = symbolic ';'
+colon  = symbolic ':'
+equals = symbolic '='
+
+-- | Parses a reserved identifier and adds it to the collection of known
+-- reserved keywords.
+reserved :: P.Stream s Char => String -> Parser s ()
+reserved name = P.label name $ token $ P.try $ do
+    void (P.string name)
+    P.notFollowedBy (P.alphaNumChar <|> P.oneOf "_.")
+
+
 -- | A string literal. @"hello"@
-literal :: (TokenParsing p, MonadPlus p) => ThriftParser p n Text
-literal = stringLiteral <|> stringLiteral'
+literal :: P.Stream s Char => Parser s Text
+literal = P.label "string literal" $ token $
+    stringLiteral '"' <|> stringLiteral '\''
 
+stringLiteral :: P.Stream s Char => Char -> Parser s Text
+stringLiteral q = fmap Text.pack $
+    P.char q >> P.manyTill PL.charLiteral (P.char q)
 
+
+integer :: P.Stream s Char => Parser s Integer
+integer = token PL.integer
+
+
 -- | An identifier in a Thrift file.
-identifier :: (TokenParsing p, MonadPlus p) => ThriftParser p n Text
-identifier = ident idStyle
+identifier :: P.Stream s Char => Parser s Text
+identifier = P.label "identifier" $ token $ do
+    name <- (:)
+        <$> (P.letterChar <|> P.char '_')
+        <*> many (P.alphaNumChar <|> P.oneOf "_.")
+    return (Text.pack name)
 
 
+-- | Top-level parser to parse complete Thrift documents.
+program :: P.Stream s Char => Parser s (T.Program P.SourcePos)
+program = whiteSpace >>
+    T.Program
+        <$> many (header     <* optionalSep)
+        <*> many (definition <* optionalSep)
+        <*  P.eof
+
 -- | Headers defined for the IDL.
-header :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Header n)
-header = choice
+header :: P.Stream s Char => Parser s (T.Header P.SourcePos)
+header = P.choice
   [ T.HeaderInclude   <$> include
   , T.HeaderNamespace <$> namespace
   ]
 
+
 -- | The IDL includes another Thrift file.
 --
 -- > include "common.thrift"
 -- >
 -- > typedef common.Foo Bar
 --
-include :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Include n)
-include = reserved "include" >> withSrcAnnot (T.Include <$> literal)
+include :: P.Stream s Char => Parser s (T.Include P.SourcePos)
+include = reserved "include" >> withPosition (T.Include <$> literal)
 
+
 -- | Namespace directives allows control of the namespace or package
 -- name used by the generated code for certain languages.
 --
 -- > namespace py my_service.generated
-namespace :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Namespace n)
-namespace = choice
+namespace :: P.Stream s Char => Parser s (T.Namespace P.SourcePos)
+namespace = P.choice
   [ reserved "namespace" >>
-    withSrcAnnot (T.Namespace <$> (text "*" <|> identifier) <*> identifier)
+    withPosition (T.Namespace <$> (star <|> identifier) <*> identifier)
   , reserved "cpp_namespace" >>
-    withSrcAnnot (T.Namespace "cpp" <$> identifier)
+    withPosition (T.Namespace "cpp" <$> identifier)
   , reserved "php_namespace" >>
-    withSrcAnnot (T.Namespace "php" <$> identifier)
+    withPosition (T.Namespace "php" <$> identifier)
   , reserved "py_module" >>
-    withSrcAnnot (T.Namespace "py" <$> identifier)
+    withPosition (T.Namespace "py" <$> identifier)
   , reserved "perl_package" >>
-    withSrcAnnot (T.Namespace "perl" <$> identifier)
+    withPosition (T.Namespace "perl" <$> identifier)
   , reserved "ruby_namespace" >>
-    withSrcAnnot (T.Namespace "rb" <$> identifier)
+    withPosition (T.Namespace "rb" <$> identifier)
   , reserved "java_package" >>
-    withSrcAnnot (T.Namespace "java" <$> identifier)
+    withPosition (T.Namespace "java" <$> identifier)
   , reserved "cocoa_package" >>
-    withSrcAnnot (T.Namespace "cocoa" <$> identifier)
+    withPosition (T.Namespace "cocoa" <$> identifier)
   , reserved "csharp_namespace" >>
-    withSrcAnnot (T.Namespace "csharp" <$> identifier)
+    withPosition (T.Namespace "csharp" <$> identifier)
   ]
+  where
+    star = symbolic '*' >> pure "*"
 
--- | Retrieve the current source annotation.
-getSrcAnnot :: Monad p => ThriftParser p n n
-getSrcAnnot = ThriftParser . lift $ Reader.ask >>= lift
 
--- | Convenience wrapper for parsers expecting a source annotation.
+-- | Convenience wrapper for parsers expecting a position.
 --
--- The source annotation will be retrieved BEFORE the parser itself is
--- executed.
-withSrcAnnot
-    :: (Functor p, Monad p)
-    => ThriftParser p n (n -> a) -> ThriftParser p n a
-withSrcAnnot p = getSrcAnnot >>= \annot -> p <*> pure annot
+-- The position will be retrieved BEFORE the parser itself is executed.
+withPosition :: P.Stream s Char => Parser s (P.SourcePos -> a) -> Parser s a
+withPosition p = P.getPosition >>= \pos -> p <*> pure pos
 
--- | Convenience wrapper for parsers that expect a docstring and a
--- source annotation.
+
+-- | Convenience wrapper for parsers that expect a docstring and a position.
 --
 -- > data Foo = Foo { bar :: Bar, doc :: Docstring, pos :: Delta }
 -- >
--- > parseFoo = docstring $ Foo <$> parseBar
-docstring
-    :: (Functor p, Monad p)
-    => ThriftParser p n (T.Docstring -> n -> a) -> ThriftParser p n a
-docstring p = lastDocstring >>= \s -> do
-    annot <- getSrcAnnot
-    p <*> pure s <*> pure annot
+-- > parseFoo = withDocstring $ Foo <$> parseBar
+withDocstring
+    :: P.Stream s Char
+    => Parser s (T.Docstring -> P.SourcePos -> a) -> Parser s a
+withDocstring p = lastDocstring >>= \s -> do
+    pos <- P.getPosition
+    p <*> pure s <*> pure pos
 
 
 -- | A constant, type, or service definition.
-definition
-    :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Definition n)
-definition = whiteSpace >> choice
+definition :: P.Stream s Char => Parser s (T.Definition P.SourcePos)
+definition = whiteSpace >> P.choice
     [ T.ConstDefinition   <$> constant
     , T.TypeDefinition    <$> typeDefinition
     , T.ServiceDefinition <$> service
@@ -297,8 +355,8 @@
 
 
 -- | A type definition.
-typeDefinition :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Type n)
-typeDefinition = choice
+typeDefinition :: P.Stream s Char => Parser s (T.Type P.SourcePos)
+typeDefinition = P.choice
     [ T.TypedefType   <$> typedef
     , T.EnumType      <$> enum
     , T.SenumType     <$> senum
@@ -311,9 +369,9 @@
 -- | A typedef is just an alias for another type.
 --
 -- > typedef common.Foo Bar
-typedef :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Typedef n)
-typedef = reserved "typedef" >>
-    docstring (T.Typedef <$> typeReference <*> identifier <*> typeAnnotations)
+typedef :: P.Stream s Char => Parser s (T.Typedef P.SourcePos)
+typedef = reserved "typedef" >> withDocstring
+    (T.Typedef <$> typeReference <*> identifier <*> typeAnnotations)
 
 
 -- | Enums are sets of named integer values.
@@ -321,12 +379,13 @@
 -- > enum Role {
 -- >     User = 1, Admin
 -- > }
-enum :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Enum n)
-enum = reserved "enum" >>
-    docstring (T.Enum
+enum :: P.Stream s Char => Parser s (T.Enum P.SourcePos)
+enum = reserved "enum" >> withDocstring
+    ( T.Enum
         <$> identifier
         <*> braces (many enumDef)
-        <*> typeAnnotations)
+        <*> typeAnnotations
+    )
 
 
 -- | A @struct@.
@@ -335,12 +394,13 @@
 -- >     1: string name
 -- >     2: Role role = Role.User;
 -- > }
-struct :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Struct n)
-struct = reserved "struct" >>
-    docstring (T.Struct
+struct :: P.Stream s Char => Parser s (T.Struct P.SourcePos)
+struct = reserved "struct" >> withDocstring
+    ( T.Struct
         <$> identifier
         <*> braces (many field)
-        <*> typeAnnotations)
+        <*> typeAnnotations
+    )
 
 
 -- | A @union@ of types.
@@ -349,12 +409,13 @@
 -- >     1: string stringValue;
 -- >     2: i32 intValue;
 -- > }
-union :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Union n)
-union = reserved "union" >>
-    docstring (T.Union
+union :: P.Stream s Char => Parser s (T.Union P.SourcePos)
+union = reserved "union" >> withDocstring
+    ( T.Union
         <$> identifier
         <*> braces (many field)
-        <*> typeAnnotations)
+        <*> typeAnnotations
+    )
 
 
 -- | An @exception@ that can be raised by service methods.
@@ -363,27 +424,28 @@
 -- >     1: optional string message
 -- >     2: required string username
 -- > }
-exception :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Exception n)
-exception = reserved "exception" >>
-     docstring (T.Exception
+exception :: P.Stream s Char => Parser s (T.Exception P.SourcePos)
+exception = reserved "exception" >> withDocstring
+    ( T.Exception
         <$> identifier
         <*> braces (many field)
-        <*> typeAnnotations)
+        <*> typeAnnotations
+    )
 
 
 -- | Whether a field is @required@ or @optional@.
-fieldRequiredness
-    :: (TokenParsing p, MonadPlus p) => ThriftParser p n T.FieldRequiredness
-fieldRequiredness = choice [
-    reserved "required" *> pure T.Required
+fieldRequiredness :: P.Stream s Char => Parser s T.FieldRequiredness
+fieldRequiredness = P.choice
+  [ reserved "required" *> pure T.Required
   , reserved "optional" *> pure T.Optional
   ]
 
+
 -- | A struct field.
-field :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Field n)
-field = docstring $
+field :: P.Stream s Char => Parser s (T.Field P.SourcePos)
+field = withDocstring $
   T.Field
-    <$> optional (integer <* symbolic ':')
+    <$> optional (integer <* colon)
     <*> optional fieldRequiredness
     <*> typeReference
     <*> identifier
@@ -393,32 +455,33 @@
 
 
 -- | A value defined inside an @enum@.
-enumDef :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.EnumDef n)
-enumDef = docstring $
+enumDef :: P.Stream s Char => Parser s (T.EnumDef P.SourcePos)
+enumDef = withDocstring $
   T.EnumDef
     <$> identifier
-    <*> optional (equals *> integer)
+    <*> optional (equals *> PL.signed whiteSpace integer)
     <*> typeAnnotations
     <*  optionalSep
 
 
--- | An string-only enum. These are a deprecated feature of Thrift and
--- shouldn't be used.
-senum :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Senum n)
-senum = reserved "senum" >> docstring
-    (T.Senum
+-- | An string-only enum. These are a deprecated feature of Thrift and shouldn't
+-- be used.
+senum :: P.Stream s Char => Parser s (T.Senum P.SourcePos)
+senum = reserved "senum" >> withDocstring
+    ( T.Senum
         <$> identifier
         <*> braces (many (literal <* optionalSep))
-        <*> typeAnnotations)
+        <*> typeAnnotations
+    )
 
 
 -- | A 'const' definition.
 --
 -- > const i32 code = 1;
-constant :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Const n)
+constant :: P.Stream s Char => Parser s (T.Const P.SourcePos)
 constant = do
   reserved "const"
-  docstring $
+  withDocstring $
     T.Const
         <$> typeReference
         <*> (identifier <* equals)
@@ -427,11 +490,11 @@
 
 
 -- | A constant value literal.
-constantValue
-    :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.ConstValue n)
-constantValue = withSrcAnnot $ choice [
-    either T.ConstInt T.ConstFloat
-                      <$> integerOrDouble
+constantValue :: P.Stream s Char => Parser s (T.ConstValue P.SourcePos)
+constantValue = withPosition $ P.choice
+  [ P.try (P.string "0x") >> T.ConstInt <$> token PL.hexadecimal
+  , either T.ConstInt T.ConstFloat
+                      <$> token (PL.signed whiteSpace PL.number)
   , T.ConstLiteral    <$> literal
   , T.ConstIdentifier <$> identifier
   , T.ConstList       <$> constList
@@ -439,12 +502,11 @@
   ]
 
 
-constList
-    :: (TokenParsing p, MonadPlus p) => ThriftParser p n [T.ConstValue n]
+constList :: P.Stream s Char => Parser s [T.ConstValue P.SourcePos]
 constList = symbolic '[' *> loop []
   where
-    loop xs = choice [
-        symbolic ']' *> return (reverse xs)
+    loop xs = P.choice
+      [ symbolic ']' *> return (reverse xs)
       , (:) <$> (constantValue <* optionalSep)
             <*> pure xs
             >>= loop
@@ -452,11 +514,11 @@
 
 
 constMap
-    :: (TokenParsing p, MonadPlus p)
-    => ThriftParser p n [(T.ConstValue n, T.ConstValue n)]
+    :: P.Stream s Char
+    => Parser s [(T.ConstValue P.SourcePos, T.ConstValue P.SourcePos)]
 constMap = symbolic '{' *> loop []
   where
-    loop xs = choice [
+    loop xs = P.choice [
         symbolic '}' *> return (reverse xs)
       , (:) <$> (constantValuePair <* optionalSep)
             <*> pure xs
@@ -465,30 +527,29 @@
 
 
 constantValuePair
-    :: (TokenParsing p, MonadPlus p)
-    => ThriftParser p n (T.ConstValue n, T.ConstValue n)
+    :: P.Stream s Char
+    => Parser s (T.ConstValue P.SourcePos, T.ConstValue P.SourcePos)
 constantValuePair =
     (,) <$> (constantValue <* colon)
         <*> (constantValue <* optionalSep)
 
 
 -- | A reference to a built-in or defined field.
-typeReference
-    :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.TypeReference n)
-typeReference = choice [
-    baseType
+typeReference :: P.Stream s Char => Parser s (T.TypeReference P.SourcePos)
+typeReference = P.choice
+  [ baseType
   , containerType
-  , withSrcAnnot (T.DefinedType <$> identifier)
+  , withPosition (T.DefinedType <$> identifier)
   ]
 
 
 baseType
-    :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.TypeReference n)
-baseType = withSrcAnnot $
-    choice [reserved s *> (v <$> typeAnnotations) | (s, v) <- bases]
+    :: P.Stream s Char => Parser s (T.TypeReference P.SourcePos)
+baseType = withPosition $
+    P.choice [reserved s *> (v <$> typeAnnotations) | (s, v) <- bases]
   where
-    bases = [
-        ("string", T.StringType)
+    bases =
+      [ ("string", T.StringType)
       , ("binary", T.BinaryType)
       , ("slist", T.SListType)
       , ("bool", T.BoolType)
@@ -502,9 +563,9 @@
 
 
 containerType
-    :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.TypeReference n)
-containerType = withSrcAnnot $
-    choice [mapType, setType, listType] <*> typeAnnotations
+    :: P.Stream s Char => Parser s (T.TypeReference P.SourcePos)
+containerType = withPosition $
+    P.choice [mapType, setType, listType] <*> typeAnnotations
   where
     mapType = reserved "map" >>
         angles (T.MapType <$> (typeReference <* comma) <*> typeReference)
@@ -517,10 +578,10 @@
 -- > service MyService {
 -- >     // ...
 -- > }
-service :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Service n)
+service :: P.Stream s Char => Parser s (T.Service P.SourcePos)
 service = do
   reserved "service"
-  docstring $
+  withDocstring $
     T.Service
         <$> identifier
         <*> optional (reserved "extends" *> identifier)
@@ -532,8 +593,8 @@
 --
 -- > Foo getFoo() throws (1: FooDoesNotExist doesNotExist);
 -- > oneway void putBar(1: Bar bar);
-function :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Function n)
-function = docstring $
+function :: P.Stream s Char => Parser s (T.Function P.SourcePos)
+function = withDocstring $
     T.Function
         <$> ((reserved "oneway" *> pure True) <|> pure False)
         <*> ((reserved "void" *> pure Nothing) <|> Just <$> typeReference)
@@ -550,24 +611,16 @@
 --
 -- These do not usually affect code generation but allow for custom logic if
 -- writing your own code generator.
-typeAnnotations
-    :: (TokenParsing p, MonadPlus p)
-    => ThriftParser p n [T.TypeAnnotation]
+typeAnnotations :: P.Stream s Char => Parser s [T.TypeAnnotation]
 typeAnnotations = parens (many typeAnnotation) <|> pure []
 
 
-typeAnnotation
-    :: (TokenParsing p, MonadPlus p)
-    => ThriftParser p n T.TypeAnnotation
+typeAnnotation :: P.Stream s Char => Parser s T.TypeAnnotation
 typeAnnotation =
     T.TypeAnnotation
         <$> identifier
         <*> (optional (equals *> literal) <* optionalSep)
 
 
-optionalSep :: (TokenParsing p, MonadPlus p) => ThriftParser p n ()
+optionalSep :: P.Stream s Char => Parser s ()
 optionalSep = void $ optional (comma <|> semi)
-
-
-equals :: (TokenParsing p, MonadPlus p) => ThriftParser p n ()
-equals = void $ symbolic '='
diff --git a/Language/Thrift/Parser/Trifecta.hs b/Language/Thrift/Parser/Trifecta.hs
deleted file mode 100644
--- a/Language/Thrift/Parser/Trifecta.hs
+++ /dev/null
@@ -1,23 +0,0 @@
--- |
--- Module      :  Language.Thrift.Parser.Trifecta
--- Copyright   :  (c) Abhinav Gupta 2015
--- License     :  BSD3
---
--- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>
--- Stability   :  experimental
---
--- Provides a parser for Thrift IDLs based on Trifecta.
---
-module Language.Thrift.Parser.Trifecta (thriftIDL) where
-
-import Text.Trifecta
-import Text.Trifecta.Delta (Delta)
-
-import qualified Language.Thrift.Parser as P
-import qualified Language.Thrift.Types  as T
-
--- | Parser for Thrift IDLs based on Trifecta.
---
--- Use with 'parseFromFile', 'parseByteString' or friends.
-thriftIDL :: Parser (T.Program Delta)
-thriftIDL = P.thriftIDL position
diff --git a/Language/Thrift/Pretty.hs b/Language/Thrift/Pretty.hs
--- a/Language/Thrift/Pretty.hs
+++ b/Language/Thrift/Pretty.hs
@@ -11,16 +11,23 @@
 -- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>
 -- Stability   :  experimental
 --
--- This module provides a pretty printer for Thrift IDLs. The pretty printer
--- preserves docstrings specified for types.
+-- This module provides a pretty printer for Thrift IDLs. Most of the printers
+-- defined in this module produce output highlighted using ANSI escape codes.
+-- Get plain output by using 'Text.PrettyPrint.ANSI.Leijen.plain'.
 --
+-- Use 'prettyPrintHighlighted' to produce output highlighted using ANSI escape
+-- codes. Note that this output will be unparseable and is suitable for printing
+-- inside a compatible terminal only. Use 'prettyPrint' if you don't want
+-- highlighted output.
+--
 -- The behavior of the printer can be customized using 'Config' objects.
 --
 -- The module also exports instances of the 'Pretty' typeclass for elements of
 -- the AST.
 module Language.Thrift.Pretty
     (
-      prettyPrint
+      prettyPrintHighlighted
+    , prettyPrint
 
     -- * Components
 
@@ -45,12 +52,394 @@
     , typeReference
     , constantValue
 
+    , docstring
+
     -- * Configuration
 
     , Config(..)
     , defaultConfig
     ) where
 
-#define PrettyPrinter Text.PrettyPrint.Leijen
-#include "Pretty/PrettyInc.hs"
-#undef PrettyPrinter
+#if __GLASGOW_HASKELL__ >= 709
+import Prelude hiding ((<$>))
+#endif
+
+import           Data.Text (Text)
+import qualified Data.Text as Text
+
+import Text.PrettyPrint.ANSI.Leijen (Doc, Pretty (..), align, bold, cyan,
+                                     double, dquotes, dullblue, empty, enclose,
+                                     group, hcat, hsep, integer, line,
+                                     linebreak, magenta, nest, plain, space,
+                                     vsep, yellow, (<$$>), (<$>), (<+>), (<>))
+
+import qualified Language.Thrift.Internal.Types as T
+import qualified Text.PrettyPrint.ANSI.Leijen   as P
+
+-- | Configuration for the pretty printer.
+data Config = Config
+    { indentWidth :: Int
+    -- ^ Number of spaces to use for indentation.
+    } deriving (Show, Ord, Eq)
+
+
+-- | Default pretty printing configuration.
+defaultConfig :: Config
+defaultConfig = Config 4
+
+-- | Top-level pretty printer for Thrift documents that uses the default
+-- configuration ('defaultConfig') for pretty printing.
+prettyPrint :: T.Program ann -> Doc
+prettyPrint = plain . prettyPrintHighlighted
+
+-- | Top-level pretty printer for Thrift documents.
+prettyPrintHighlighted :: T.Program ann -> Doc
+prettyPrintHighlighted = program defaultConfig
+
+-- | Pretty print a Thrift IDL.
+program :: Config -> T.Program ann -> Doc
+program c T.Program{..} =
+    ( if null programHeaders
+        then empty
+        else vsep (map header programHeaders) <$> line
+    ) <> map (definition c) programDefinitions `sepBy` (line <> line)
+
+instance Pretty (T.Program a) where
+    pretty = program defaultConfig
+
+-- | Print the headers for a program.
+header :: T.Header ann -> Doc
+header (T.HeaderInclude inc) = include inc
+header (T.HeaderNamespace ns) = namespace ns
+
+instance Pretty (T.Header a) where
+    pretty = header
+
+include :: T.Include ann -> Doc
+include T.Include{..} = reserved "include" <+> literal includePath
+
+instance Pretty (T.Include a) where
+    pretty = include
+
+namespace :: T.Namespace ann -> Doc
+namespace T.Namespace{..} = hsep
+    [reserved "namespace", text namespaceLanguage, text namespaceName]
+
+instance Pretty (T.Namespace a) where
+    pretty = namespace
+
+-- | Print a constant, type, or service definition.
+definition :: Config -> T.Definition ann -> Doc
+definition c (T.ConstDefinition cd) = constant c cd
+definition c (T.TypeDefinition def) = typeDefinition c def
+definition c (T.ServiceDefinition s) = service c s
+
+instance Pretty (T.Definition a) where
+    pretty = definition defaultConfig
+
+constant :: Config -> T.Const ann -> Doc
+constant c T.Const{..} = constDocstring $$ hsep
+    [ reserved "const"
+    , typeReference c constValueType
+    , declare constName
+    , equals
+    , constantValue c constValue
+    ]
+
+instance Pretty (T.Const a) where
+    pretty = constant defaultConfig
+
+service :: Config -> T.Service ann -> Doc
+service c@Config{indentWidth} T.Service{..} =
+  serviceDocstring $$
+    reserved "service" <+> declare serviceName <> extends <+>
+    block indentWidth (line <> line) (map (function c) serviceFunctions) <>
+    typeAnnots c serviceAnnotations
+  where
+    extends = case serviceExtends of
+      Nothing -> empty
+      Just name -> space <> reserved "extends" <+> text name
+
+instance Pretty (T.Service a) where
+    pretty = service defaultConfig
+
+-- | Pretty print a function definition.
+--
+function :: Config -> T.Function ann -> Doc
+function c@Config{indentWidth} T.Function{..} = functionDocstring $$
+  oneway <> returnType <+> text functionName <>
+    encloseSep
+        indentWidth lparen rparen comma
+        (map (field c) functionParameters) <>
+    exceptions <> typeAnnots c functionAnnotations <> semi
+  where
+    exceptions = case functionExceptions of
+      Nothing -> empty
+      Just es -> space <> reserved "throws" <+>
+        encloseSep indentWidth lparen rparen comma (map (field c) es)
+    returnType = case functionReturnType of
+      Nothing -> reserved "void"
+      Just rt -> typeReference c rt
+    oneway =
+      if functionOneWay
+          then reserved "oneway" <> space
+          else empty
+
+instance Pretty (T.Function a) where
+    pretty = function defaultConfig
+
+typeDefinition :: Config -> T.Type ann -> Doc
+typeDefinition c td = case td of
+  T.TypedefType   t -> c `typedef`   t
+  T.EnumType      t -> c `enum`      t
+  T.StructType    t -> c `struct`    t
+  T.UnionType     t -> c `union`     t
+  T.ExceptionType t -> c `exception` t
+  T.SenumType     t -> c `senum`     t
+
+instance Pretty (T.Type a) where
+    pretty = typeDefinition defaultConfig
+
+typedef :: Config -> T.Typedef ann -> Doc
+typedef c T.Typedef{..} = typedefDocstring $$
+    reserved "typedef" <+> typeReference c typedefTargetType <+>
+    declare typedefName <> typeAnnots c typedefAnnotations
+
+instance Pretty (T.Typedef a) where
+    pretty = typedef defaultConfig
+
+enum :: Config -> T.Enum ann -> Doc
+enum c@Config{indentWidth} T.Enum{..} = enumDocstring $$
+    reserved "enum" <+> declare enumName <+>
+      block indentWidth (comma <> line) (map (enumValue c) enumValues)
+    <> typeAnnots c enumAnnotations
+
+instance Pretty (T.Enum a) where
+    pretty = enum defaultConfig
+
+struct :: Config -> T.Struct ann -> Doc
+struct c@Config{indentWidth} T.Struct{..} = structDocstring $$
+    reserved "struct" <+> declare structName <+>
+      block indentWidth line (map (\f -> field c f <> semi) structFields)
+    <> typeAnnots c structAnnotations
+
+instance Pretty (T.Struct a) where
+    pretty = struct defaultConfig
+
+union :: Config -> T.Union ann -> Doc
+union c@Config{indentWidth} T.Union{..} = unionDocstring $$
+    reserved "union" <+> declare unionName <+>
+      block indentWidth line (map (\f -> field c f <> semi) unionFields)
+    <> typeAnnots c unionAnnotations
+
+instance Pretty (T.Union a) where
+    pretty = union defaultConfig
+
+exception :: Config -> T.Exception ann -> Doc
+exception c@Config{indentWidth} T.Exception{..} = exceptionDocstring $$
+    reserved "exception" <+> declare exceptionName <+>
+      block indentWidth line (map (\f -> field c f <> semi) exceptionFields)
+    <> typeAnnots c exceptionAnnotations
+
+instance Pretty (T.Exception a) where
+    pretty = exception defaultConfig
+
+senum :: Config -> T.Senum ann -> Doc
+senum c@Config{indentWidth} T.Senum{..} = senumDocstring $$
+    reserved "senum" <+> declare senumName <+>
+      encloseSep indentWidth lbrace rbrace comma (map literal senumValues)
+    <> typeAnnots c senumAnnotations
+
+instance Pretty (T.Senum a) where
+    pretty = senum defaultConfig
+
+field :: Config -> T.Field ann -> Doc
+field c T.Field{..} = fieldDocstring $$ hcat
+    [ case fieldIdentifier of
+        Nothing -> empty
+        Just i  -> yellow (integer i) <> colon <> space
+    , case fieldRequiredness of
+        Nothing -> empty
+        Just r  -> requiredness r <> space
+    , typeReference c fieldValueType
+    , space
+    , text fieldName
+    , case fieldDefaultValue of
+        Nothing -> empty
+        Just v  -> space <> equals <+> constantValue c v
+    , typeAnnots c fieldAnnotations
+    ]
+
+instance Pretty (T.Field a) where
+    pretty = field defaultConfig
+
+requiredness :: T.FieldRequiredness -> Doc
+requiredness T.Optional = reserved "optional"
+requiredness T.Required = reserved "required"
+
+instance Pretty T.FieldRequiredness where
+    pretty = requiredness
+
+enumValue :: Config -> T.EnumDef ann -> Doc
+enumValue c T.EnumDef{..} = enumDefDocstring $$
+    text enumDefName <> value <> typeAnnots c enumDefAnnotations
+  where
+    value = case enumDefValue of
+      Nothing -> empty
+      Just v  -> space <> equals <+> integer v
+
+instance Pretty (T.EnumDef a) where
+    pretty = enumValue defaultConfig
+
+-- | Pretty print a field type.
+typeReference :: Config -> T.TypeReference ann -> Doc
+typeReference c ft = case ft of
+  T.DefinedType t _ -> text t
+
+  T.StringType anns _ -> reserved "string" <> typeAnnots c anns
+  T.BinaryType anns _ -> reserved "binary" <> typeAnnots c anns
+  T.SListType  anns _ -> reserved "slist"  <> typeAnnots c anns
+  T.BoolType   anns _ -> reserved "bool"   <> typeAnnots c anns
+  T.ByteType   anns _ -> reserved "byte"   <> typeAnnots c anns
+  T.I16Type    anns _ -> reserved "i16"    <> typeAnnots c anns
+  T.I32Type    anns _ -> reserved "i32"    <> typeAnnots c anns
+  T.I64Type    anns _ -> reserved "i64"    <> typeAnnots c anns
+  T.DoubleType anns _ -> reserved "double" <> typeAnnots c anns
+
+  T.MapType k v anns _ ->
+    reserved "map"
+        <> enclose langle rangle
+            (typeReference c k <> comma <+> typeReference c v)
+        <> typeAnnots c anns
+  T.SetType v anns _ ->
+    reserved "set"
+        <> enclose langle rangle (typeReference c v)
+        <> typeAnnots c anns
+  T.ListType v anns _ ->
+    reserved "list"
+        <> enclose langle rangle (typeReference c v)
+        <> typeAnnots c anns
+
+instance Pretty (T.TypeReference a) where
+    pretty = typeReference defaultConfig
+
+-- | Pretty print a constant value.
+constantValue :: Config -> T.ConstValue ann -> Doc
+constantValue c@Config{indentWidth} value = case value of
+  T.ConstInt        i _ -> integer i
+  T.ConstFloat      f _ -> double  f
+  T.ConstLiteral    l _ -> literal l
+  T.ConstIdentifier i _ -> text    i
+  T.ConstList      vs _ ->
+    encloseSep indentWidth lbracket rbracket comma $ map (constantValue c) vs
+  T.ConstMap       vs _ ->
+    encloseSep indentWidth lbrace rbrace comma $
+      map (\(k, v) -> constantValue c k <> colon <+> constantValue c v) vs
+
+instance Pretty (T.ConstValue a) where
+    pretty = constantValue defaultConfig
+
+typeAnnots :: Config -> [T.TypeAnnotation] -> Doc
+typeAnnots _ [] = empty
+typeAnnots Config{indentWidth} anns =
+    space <> encloseSep indentWidth lparen rparen comma (map typeAnnot anns)
+
+typeAnnot :: T.TypeAnnotation -> Doc
+typeAnnot T.TypeAnnotation{..} =
+    text typeAnnotationName <> value
+  where
+    value = case typeAnnotationValue of
+        Nothing -> empty
+        Just v  -> space <> equals <+> literal v
+
+instance Pretty T.TypeAnnotation where
+    pretty = typeAnnot
+
+literal :: Text -> Doc
+literal = cyan . dquotes . text
+    -- TODO: escaping?
+
+text :: Text -> Doc
+text = P.text . Text.unpack
+
+reserved :: String -> Doc
+reserved = magenta . P.text
+
+op :: String -> Doc
+op = yellow . P.text
+
+declare :: Text -> Doc
+declare = bold . text
+
+($$) :: T.Docstring -> Doc -> Doc
+($$) Nothing y = y
+($$) (Just t) y =
+    if Text.null t'
+        then y
+        else docstring t' <$> y
+  where
+    t' = Text.strip t
+
+infixr 1 $$
+
+docstring :: Text -> Doc
+docstring = dullblue . wrapComments . Text.lines
+  where
+    wrapComments ls = align . vsep
+      $ text "/**"
+      : map (\l -> text " *" <+> text l) ls
+     ++ [text " */"]
+
+block :: Int -> Doc -> [Doc] -> Doc
+block indent s items = enclose lbrace rbrace $
+    nest indent (linebreak <> (items `sepBy` s)) <> linebreak
+
+sepBy :: [Doc] -> Doc -> Doc
+sepBy [] _ = empty
+sepBy [x] _ = x
+sepBy (x:xs) s = x <> s <> sepBy xs s
+
+encloseSep :: Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
+encloseSep _ left right _ [] = left <> right
+encloseSep _ left right _ [v] = left <> v <> right
+encloseSep indent left right s vs = group $
+    nest indent (left <$$> go vs) <$$> right
+  where go [] = empty
+        go [x] = x
+        go (x:xs) = (x <> s) <$> go xs
+
+lbrace :: Doc
+lbrace = op "{"
+
+rbrace :: Doc
+rbrace = op "}"
+
+lparen :: Doc
+lparen = op "("
+
+rparen :: Doc
+rparen = op ")"
+
+lbracket :: Doc
+lbracket = op "["
+
+rbracket :: Doc
+rbracket = op "]"
+
+langle :: Doc
+langle = op "<"
+
+rangle :: Doc
+rangle = op ">"
+
+comma :: Doc
+comma = op ","
+
+semi :: Doc
+semi = op ";"
+
+colon :: Doc
+colon = op ":"
+
+equals :: Doc
+equals = op "="
diff --git a/Language/Thrift/Pretty/ANSI.hs b/Language/Thrift/Pretty/ANSI.hs
deleted file mode 100644
--- a/Language/Thrift/Pretty/ANSI.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-{-# LANGUAGE CPP               #-}
-{-# LANGUAGE NamedFieldPuns    #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
--- |
--- Module      :  Language.Thrift.Pretty.ANSI
--- Copyright   :  (c) Abhinav Gupta 2015
--- License     :  BSD3
---
--- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>
--- Stability   :  experimental
---
--- This module provides a pretty printer for Thrift IDLs that produces colored
--- output. It is essentially the same as "Language.Thrift.Pretty" with the
--- exception of the colored output.
---
--- The behavior of the printer can be customized using 'Config' objects.
---
--- The system uses ANSI escape codes to produce colored output. That makes the
--- text output of this pretty printer unparseable without printing to a
--- supported terminal. If this is undesirable, use
--- 'Text.PrettyPrint.ANSI.Leijen.plain' to discard coloring information, or
--- simply use the "Language.Thrift.Pretty" pretty printer instead.
---
--- As with "Language.Thrift.Pretty", this module exports instances of the
--- 'Pretty' typeclass for elements of the AST.
-module Language.Thrift.Pretty.ANSI
-    (
-      prettyPrint
-
-    -- * Components
-
-    , program
-
-    , header
-    , include
-    , namespace
-
-    , definition
-    , constant
-    , typeDefinition
-    , service
-
-    , typedef
-    , enum
-    , struct
-    , union
-    , exception
-    , senum
-
-    , typeReference
-    , constantValue
-
-    -- * Configuration
-
-    , Config(..)
-    , defaultConfig
-    ) where
-
-#define PrettyPrinter Text.PrettyPrint.ANSI.Leijen
-#define PrettyPrinterSupportsHighlighting
-#include "PrettyInc.hs"
-#undef PrettyPrinterSupportsHighlighting
-#undef PrettyPrinter
diff --git a/Language/Thrift/Pretty/PrettyInc.hs b/Language/Thrift/Pretty/PrettyInc.hs
deleted file mode 100644
--- a/Language/Thrift/Pretty/PrettyInc.hs
+++ /dev/null
@@ -1,383 +0,0 @@
--- This file implements the prettty printer. It is included with wl-pprint and
--- ansi-wl-pprint in scope.
-
-#if __GLASGOW_HASKELL__ >= 709
-import Prelude hiding (lines, (<$>))
-#else
-import Prelude hiding (lines)
-#endif
-
-import Data.Text     (Text, lines, strip, unpack)
-import PrettyPrinter (Doc, align, double, dquotes, empty, nest, enclose, group, hcat, Pretty(..),
-                      hsep, integer, line, linebreak, space, vsep, (<$$>),
-                      (<$>), (<+>), (<>))
-
-import qualified PrettyPrinter as P
-
-import qualified Language.Thrift.Internal.Types as T
-
-import Language.Thrift.Pretty.Types
-
-
-bold, dullblue, magenta, yellow, cyan :: Doc -> Doc
-#ifdef PrettyPrinterSupportsHighlighting
-bold = P.bold
-dullblue = P.dullblue
-magenta = P.magenta
-yellow = P.yellow
-cyan = P.cyan
-#else
-bold = id
-dullblue = id
-magenta = id
-yellow = id
-cyan = id
-#endif
-
-
--- | Top-level pretty printer for Thrift documents that uses the default
--- configuration ('defaultConfig') for pretty printing.
-prettyPrint :: T.Program ann -> Doc
-prettyPrint = program defaultConfig
-
-
--- | Pretty print a Thrift IDL.
-program :: Config -> T.Program ann -> Doc
-program c T.Program{..} =
-    vsep (map header programHeaders) <$> line <>
-    map (definition c) programDefinitions `sepBy` (line <> line)
-
-instance Pretty (T.Program a) where
-    pretty = program defaultConfig
-
--- | Print the headers for a program.
-header :: T.Header ann -> Doc
-header (T.HeaderInclude inc) = include inc
-header (T.HeaderNamespace ns) = namespace ns
-
-instance Pretty (T.Header a) where
-    pretty = header
-
-include :: T.Include ann -> Doc
-include T.Include{..} = reserved "include" <+> literal includePath
-
-instance Pretty (T.Include a) where
-    pretty = include
-
-namespace :: T.Namespace ann -> Doc
-namespace T.Namespace{..} = hsep
-    [reserved "namespace", text namespaceLanguage, text namespaceName]
-
-instance Pretty (T.Namespace a) where
-    pretty = namespace
-
--- | Print a constant, type, or service definition.
-definition :: Config -> T.Definition ann -> Doc
-definition c (T.ConstDefinition cd) = constant c cd
-definition c (T.TypeDefinition def) = typeDefinition c def
-definition c (T.ServiceDefinition s) = service c s
-
-instance Pretty (T.Definition a) where
-    pretty = definition defaultConfig
-
-constant :: Config -> T.Const ann -> Doc
-constant c T.Const{..} = constDocstring $$ hsep
-    [ reserved "const"
-    , typeReference c constValueType
-    , declare constName
-    , equals
-    , constantValue c constValue
-    ]
-
-instance Pretty (T.Const a) where
-    pretty = constant defaultConfig
-
-service :: Config -> T.Service ann -> Doc
-service c@Config{indentWidth} T.Service{..} =
-  serviceDocstring $$
-    reserved "service" <+> declare serviceName <> extends <+>
-    block indentWidth (line <> line) (map (function c) serviceFunctions) <>
-    typeAnnots c serviceAnnotations
-  where
-    extends = case serviceExtends of
-      Nothing -> empty
-      Just name -> space <> reserved "extends" <+> text name
-
-instance Pretty (T.Service a) where
-    pretty = service defaultConfig
-
--- | Pretty print a function definition.
---
-function :: Config -> T.Function ann -> Doc
-function c@Config{indentWidth} T.Function{..} = functionDocstring $$
-  oneway <> returnType <+> text functionName <>
-    encloseSep
-        indentWidth lparen rparen comma
-        (map (field c) functionParameters) <>
-    exceptions <> typeAnnots c functionAnnotations <> semi
-  where
-    exceptions = case functionExceptions of
-      Nothing -> empty
-      Just es -> space <> reserved "throws" <+>
-        encloseSep indentWidth lparen rparen comma (map (field c) es)
-    returnType = case functionReturnType of
-      Nothing -> reserved "void"
-      Just rt -> typeReference c rt
-    oneway =
-      if functionOneWay
-          then reserved "oneway" <> space
-          else empty
-
-instance Pretty (T.Function a) where
-    pretty = function defaultConfig
-
-typeDefinition :: Config -> T.Type ann -> Doc
-typeDefinition c td = case td of
-  T.TypedefType   t -> c `typedef`   t
-  T.EnumType      t -> c `enum`      t
-  T.StructType    t -> c `struct`    t
-  T.UnionType     t -> c `union`     t
-  T.ExceptionType t -> c `exception` t
-  T.SenumType     t -> c `senum`     t
-
-instance Pretty (T.Type a) where
-    pretty = typeDefinition defaultConfig
-
-typedef :: Config -> T.Typedef ann -> Doc
-typedef c T.Typedef{..} = typedefDocstring $$
-    reserved "typedef" <+> typeReference c typedefTargetType <+>
-    declare typedefName <> typeAnnots c typedefAnnotations
-
-instance Pretty (T.Typedef a) where
-    pretty = typedef defaultConfig
-
-enum :: Config -> T.Enum ann -> Doc
-enum c@Config{indentWidth} T.Enum{..} = enumDocstring $$
-    reserved "enum" <+> declare enumName <+>
-      block indentWidth (comma <> line) (map (enumValue c) enumValues)
-    <> typeAnnots c enumAnnotations
-
-instance Pretty (T.Enum a) where
-    pretty = enum defaultConfig
-
-struct :: Config -> T.Struct ann -> Doc
-struct c@Config{indentWidth} T.Struct{..} = structDocstring $$
-    reserved "struct" <+> declare structName <+>
-      block indentWidth line (map (\f -> field c f <> semi) structFields)
-    <> typeAnnots c structAnnotations
-
-instance Pretty (T.Struct a) where
-    pretty = struct defaultConfig
-
-union :: Config -> T.Union ann -> Doc
-union c@Config{indentWidth} T.Union{..} = unionDocstring $$
-    reserved "union" <+> declare unionName <+>
-      block indentWidth line (map (\f -> field c f <> semi) unionFields)
-    <> typeAnnots c unionAnnotations
-
-instance Pretty (T.Union a) where
-    pretty = union defaultConfig
-
-exception :: Config -> T.Exception ann -> Doc
-exception c@Config{indentWidth} T.Exception{..} = exceptionDocstring $$
-    reserved "exception" <+> declare exceptionName <+>
-      block indentWidth line (map (\f -> field c f <> semi) exceptionFields)
-    <> typeAnnots c exceptionAnnotations
-
-instance Pretty (T.Exception a) where
-    pretty = exception defaultConfig
-
-senum :: Config -> T.Senum ann -> Doc
-senum c@Config{indentWidth} T.Senum{..} = senumDocstring $$
-    reserved "senum" <+> declare senumName <+>
-      encloseSep indentWidth lbrace rbrace comma (map literal senumValues)
-    <> typeAnnots c senumAnnotations
-
-instance Pretty (T.Senum a) where
-    pretty = senum defaultConfig
-
-field :: Config -> T.Field ann -> Doc
-field c T.Field{..} = fieldDocstring $$ hcat
-    [ case fieldIdentifier of
-        Nothing -> empty
-        Just i  -> yellow (integer i) <> colon <> space
-    , case fieldRequiredness of
-        Nothing -> empty
-        Just r  -> requiredness r <> space
-    , typeReference c fieldValueType
-    , space
-    , text fieldName
-    , case fieldDefaultValue of
-        Nothing -> empty
-        Just v  -> space <> equals <+> constantValue c v
-    , typeAnnots c fieldAnnotations
-    ]
-
-instance Pretty (T.Field a) where
-    pretty = field defaultConfig
-
-requiredness :: T.FieldRequiredness -> Doc
-requiredness T.Optional = reserved "optional"
-requiredness T.Required = reserved "required"
-
-instance Pretty T.FieldRequiredness where
-    pretty = requiredness
-
-enumValue :: Config -> T.EnumDef ann -> Doc
-enumValue c T.EnumDef{..} = enumDefDocstring $$
-    text enumDefName <> value <> typeAnnots c enumDefAnnotations
-  where
-    value = case enumDefValue of
-      Nothing -> empty
-      Just v  -> space <> equals <+> integer v
-
-instance Pretty (T.EnumDef a) where
-    pretty = enumValue defaultConfig
-
--- | Pretty print a field type.
-typeReference :: Config -> T.TypeReference ann -> Doc
-typeReference c ft = case ft of
-  T.DefinedType t _ -> text t
-
-  T.StringType anns _ -> reserved "string" <> typeAnnots c anns
-  T.BinaryType anns _ -> reserved "binary" <> typeAnnots c anns
-  T.SListType  anns _ -> reserved "slist"  <> typeAnnots c anns
-  T.BoolType   anns _ -> reserved "bool"   <> typeAnnots c anns
-  T.ByteType   anns _ -> reserved "byte"   <> typeAnnots c anns
-  T.I16Type    anns _ -> reserved "i16"    <> typeAnnots c anns
-  T.I32Type    anns _ -> reserved "i32"    <> typeAnnots c anns
-  T.I64Type    anns _ -> reserved "i64"    <> typeAnnots c anns
-  T.DoubleType anns _ -> reserved "double" <> typeAnnots c anns
-
-  T.MapType k v anns _ ->
-    reserved "map"
-        <> enclose langle rangle
-            (typeReference c k <> comma <+> typeReference c v)
-        <> typeAnnots c anns
-  T.SetType v anns _ ->
-    reserved "set"
-        <> enclose langle rangle (typeReference c v)
-        <> typeAnnots c anns
-  T.ListType v anns _ ->
-    reserved "list"
-        <> enclose langle rangle (typeReference c v)
-        <> typeAnnots c anns
-
-instance Pretty (T.TypeReference a) where
-    pretty = typeReference defaultConfig
-
--- | Pretty print a constant value.
-constantValue :: Config -> T.ConstValue ann -> Doc
-constantValue c@Config{indentWidth} value = case value of
-  T.ConstInt        i _ -> integer i
-  T.ConstFloat      f _ -> double  f
-  T.ConstLiteral    l _ -> literal l
-  T.ConstIdentifier i _ -> text    i
-  T.ConstList      vs _ ->
-    encloseSep indentWidth lbracket rbracket comma $ map (constantValue c) vs
-  T.ConstMap       vs _ ->
-    encloseSep indentWidth lbrace rbrace comma $
-      map (\(k, v) -> constantValue c k <> colon <+> constantValue c v) vs
-
-instance Pretty (T.ConstValue a) where
-    pretty = constantValue defaultConfig
-
-typeAnnots :: Config -> [T.TypeAnnotation] -> Doc
-typeAnnots _ [] = empty
-typeAnnots Config{indentWidth} anns =
-    space <> encloseSep indentWidth lparen rparen comma (map typeAnnot anns)
-
-typeAnnot :: T.TypeAnnotation -> Doc
-typeAnnot T.TypeAnnotation{..} =
-    text typeAnnotationName <> value
-  where
-    value = case typeAnnotationValue of
-        Nothing -> empty
-        Just v  -> space <> equals <+> literal v
-
-instance Pretty T.TypeAnnotation where
-    pretty = typeAnnot
-
-literal :: Text -> Doc
-literal = cyan . dquotes . text
-    -- TODO: escaping?
-
-text :: Text -> Doc
-text = P.text . unpack
-
-reserved :: String -> Doc
-reserved = magenta . P.text
-
-op :: String -> Doc
-op = yellow . P.text
-
-declare :: Text -> Doc
-declare = bold . text
-
-($$) :: T.Docstring -> Doc -> Doc
-($$) Nothing y = y
-($$) (Just t) y = case lines (strip t) of
-  [] -> y
-  ls -> dullblue (wrapComments ls) <$> y
-  where
-    wrapComments ls = align . vsep
-      $ text "/**"
-      : map (\l -> text " *" <+> text l) ls
-     ++ [text " */"]
-
-infixr 1 $$
-
-
-block :: Int -> Doc -> [Doc] -> Doc
-block indent s items = enclose lbrace rbrace $
-    nest indent (linebreak <> (items `sepBy` s)) <> linebreak
-
-sepBy :: [Doc] -> Doc -> Doc
-sepBy [] _ = empty
-sepBy [x] _ = x
-sepBy (x:xs) s = x <> s <> sepBy xs s
-
-encloseSep :: Int -> Doc -> Doc -> Doc -> [Doc] -> Doc
-encloseSep _ left right _ [] = left <> right
-encloseSep _ left right _ [v] = left <> v <> right
-encloseSep indent left right s vs = group $
-    nest indent (left <$$> go vs) <$$> right
-  where go [] = empty
-        go [x] = x
-        go (x:xs) = (x <> s) <$> go xs
-
-lbrace :: Doc
-lbrace = op "{"
-
-rbrace :: Doc
-rbrace = op "}"
-
-lparen :: Doc
-lparen = op "("
-
-rparen :: Doc
-rparen = op ")"
-
-lbracket :: Doc
-lbracket = op "["
-
-rbracket :: Doc
-rbracket = op "]"
-
-langle :: Doc
-langle = op "<"
-
-rangle :: Doc
-rangle = op ">"
-
-comma :: Doc
-comma = op ","
-
-semi :: Doc
-semi = op ";"
-
-colon :: Doc
-colon = op ":"
-
-equals :: Doc
-equals = op "="
diff --git a/Language/Thrift/Pretty/Types.hs b/Language/Thrift/Pretty/Types.hs
deleted file mode 100644
--- a/Language/Thrift/Pretty/Types.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Language.Thrift.Pretty.Types
-    ( Config(..)
-    , defaultConfig
-    ) where
-
--- | Configuration for the pretty printer.
-data Config = Config
-    { indentWidth :: Int
-    -- ^ Number of spaces to use for indentation.
-    } deriving (Show, Ord, Eq)
-
-
--- | Default pretty printing configuration.
-defaultConfig :: Config
-defaultConfig = Config 4
diff --git a/Language/Thrift/Types.hs b/Language/Thrift/Types.hs
--- a/Language/Thrift/Types.hs
+++ b/Language/Thrift/Types.hs
@@ -9,14 +9,19 @@
 -- This module defines types that compose a Thrift IDL file.
 --
 -- Most of the types have an optional @srcAnnot@ parameter that represents a
--- parser-specific source annotation. With @trifecta@ this can hold the
--- 'Text.Trifecta.Delta.Delta'. If you do not have need of this, you can use
--- @()@ as the parameter.
+-- source annotation. The parser produces types annotated with their position
+-- in the Thrift file ('Text.Megaparsec.SourcePos'). When constructing the AST
+-- by hand, you can use @()@. The types are @Functor@s so you can use 'fmap'
+-- to change the annotation on all objects in a tree.
 --
+-- Lenses for attributes of most types are provided for use with the `lens`
+-- library.
+--
+-- Types representing the AST all have 'Text.PrettyPrint.ANSI.Leijen.Pretty'
+-- instances to go with them.
 module Language.Thrift.Types
     ( module Language.Thrift.Internal.Types
     ) where
 
 import Language.Thrift.Internal.Types
 import Language.Thrift.Pretty         ()
-import Language.Thrift.Pretty.ANSI    ()
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -6,19 +6,14 @@
 field, above which they were added. These are retained when the document is
 sent through the pretty printer.
 
-The parser uses [`parsers`] to allow plugging in the underlying parser. A
-default [`trifecta`] based parser is provided.
-
-The pretty printer supports both, [`wl-pprint`] and [`ansi-wl-pprint`]. The
-`ansi-wl-pprint`-based pretty printer produces colored output.
+The parser uses [`megaparsec`] and the pretty printer [`ansi-wl-pprint`]. The
+pretty printer can produce syntax highlighted output.
 
 Haddock-generated docs are available on [Hackage] and [here].
 
   [build-status]: https://travis-ci.org/abhinav/language-thrift.svg?branch=master
   [Thrift IDL format]: http://thrift.apache.org/docs/idl
-  [`parsers`]: http://hackage.haskell.org/package/parsers
-  [`trifecta`]: http://hackage.haskell.org/package/trifecta
-  [`wl-pprint`]: http://hackage.haskell.org/package/wl-pprint
+  [`megaparsec`]: http://hackage.haskell.org/package/megaparsec
   [`ansi-wl-pprint`]: http://hackage.haskell.org/package/ansi-wl-pprint
   [Hackage]: http://hackage.haskell.org/package/language-thrift
   [here]: http://abhinavg.net/language-thrift/
diff --git a/examples/generateHaskellTypes.hs b/examples/generateHaskellTypes.hs
--- a/examples/generateHaskellTypes.hs
+++ b/examples/generateHaskellTypes.hs
@@ -18,25 +18,18 @@
 import Data.Maybe  (isNothing)
 import Data.Text   (Text, unpack)
 import System.Exit (exitFailure)
-import System.IO   (stderr, stdout)
+import System.IO   (hPrint, hPutStrLn, stderr, stdout)
 
-import qualified Data.Text                    as Text
-import qualified Text.PrettyPrint.ANSI.Leijen as AnsiPP
-import           Text.PrettyPrint.Leijen      hiding (list, tupled)
-import           Text.Trifecta                (Result (..), parseString)
-import           Text.Trifecta.Delta          (Delta (Directed))
+import Text.PrettyPrint.ANSI.Leijen hiding (list, tupled)
 
-import Language.Thrift.Parser.Trifecta (thriftIDL)
+import qualified Data.Text as Text
 
+import Language.Thrift.Parser (parse)
+
 import qualified Language.Thrift.Types as T
 
 die :: String -> IO a
-die s = putStrLn s >> exitFailure
-
--- | '<$>' with the arguments flipped.
-(<&>) :: Functor f => f a -> (a -> b) -> f b
-(<&>) = flip fmap
-infixl 1 <&>
+die s = hPutStrLn stderr s >> exitFailure
 
 ($$) :: T.Docstring -> Doc -> Doc
 ($$) Nothing y = y
@@ -262,9 +255,9 @@
 
 main :: IO ()
 main = do
-    result <- getContents <&> parseString thriftIDL (Directed "stdin" 0 0 0 0)
+    result <- parse "stdin" `fmap` getContents
     case result of
-        Success p -> generateOutput p
-        Failure doc -> do
-            AnsiPP.displayIO stderr $ AnsiPP.renderPretty 0.8 80 doc
+        Right p -> generateOutput p
+        Left err -> do
+            hPrint stderr err
             die "Parse Failed"
diff --git a/examples/reformatIDL.hs b/examples/reformatIDL.hs
--- a/examples/reformatIDL.hs
+++ b/examples/reformatIDL.hs
@@ -6,18 +6,16 @@
 --
 -- Docstrings in the IDL are preserved but COMMENTS WILL BE LOST.
 
-import System.IO               (stderr)
-import Text.Trifecta           (Result (..), parseString)
-import Text.Trifecta.Delta     (Delta (Directed))
+import System.Exit (exitFailure)
+import System.IO   (stderr)
 
 import qualified Text.PrettyPrint.ANSI.Leijen as PP
 
-import Language.Thrift.Parser.Trifecta (thriftIDL)
+import Language.Thrift.Parser (parse)
 
 main :: IO ()
 main = do
-    result <-
-        parseString thriftIDL (Directed "stdin" 0 0 0 0) `fmap` getContents
+    result <- parse "stdin" `fmap` getContents
     case result of
-        Success p   -> PP.putDoc (PP.pretty p) >> putStrLn ""
-        Failure doc -> PP.displayIO stderr $ PP.renderPretty 0.8 80 doc
+        Right p  -> PP.putDoc (PP.pretty p) >> putStrLn ""
+        Left err -> print err >> exitFailure
diff --git a/language-thrift.cabal b/language-thrift.cabal
--- a/language-thrift.cabal
+++ b/language-thrift.cabal
@@ -1,5 +1,5 @@
 name: language-thrift
-version: 0.7.0.1
+version: 0.8.0.0
 cabal-version: >=1.10
 build-type: Simple
 license: BSD3
@@ -13,10 +13,10 @@
 category: Language
 author: Abhinav Gupta
 extra-source-files:
-    Language/Thrift/Pretty/PrettyInc.hs
     README.md
     CHANGES.md
     examples/*.hs
+    test/data/*.txt
 
 source-repository head
     type: git
@@ -25,22 +25,16 @@
 library
     exposed-modules:
         Language.Thrift.Parser
-        Language.Thrift.Parser.Trifecta
         Language.Thrift.Pretty
-        Language.Thrift.Pretty.ANSI
         Language.Thrift.Types
     build-depends:
         base >=4.7 && <4.9,
         ansi-wl-pprint >=0.6 && <0.7,
-        lens >=4.0 && <5.0,
-        parsers >=0.12 && <0.13,
+        megaparsec >=4.0 && <5.0,
         text >=1.2,
-        transformers -any,
-        trifecta >=1.5 && <1.6,
-        wl-pprint >=1.1
+        transformers -any
     default-language: Haskell2010
     other-modules:
-        Language.Thrift.Pretty.Types
         Language.Thrift.Internal.Types
     ghc-options: -Wall
 
@@ -52,11 +46,9 @@
         ansi-wl-pprint -any,
         hspec >=2.0,
         hspec-discover >=2.1,
+        megaparsec -any,
         QuickCheck >=2.5,
-        parsers -any,
         text -any,
-        trifecta -any,
-        wl-pprint -any,
         language-thrift -any
     default-language: Haskell2010
     hs-source-dirs: test
diff --git a/test/Language/Thrift/Arbitrary.hs b/test/Language/Thrift/Arbitrary.hs
--- a/test/Language/Thrift/Arbitrary.hs
+++ b/test/Language/Thrift/Arbitrary.hs
@@ -85,7 +85,7 @@
     shrink = genericShrink
     arbitrary = T.Namespace <$> elements scopes <*> arbitrary <*> pure ()
       where
-        scopes = ["py", "rb", "java", "hs", "cpp"]
+        scopes = ["*", "py", "rb", "java", "hs", "cpp"]
 
 
 instance Arbitrary (T.Definition ()) where
diff --git a/test/Language/Thrift/ParserSpec.hs b/test/Language/Thrift/ParserSpec.hs
--- a/test/Language/Thrift/ParserSpec.hs
+++ b/test/Language/Thrift/ParserSpec.hs
@@ -1,12 +1,16 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections     #-}
 module Language.Thrift.ParserSpec (spec) where
 
 #if __GLASGOW_HASKELL__ < 709
 import Control.Applicative
 #endif
 
+import Control.Monad
+import Data.Text       (pack)
 import Test.Hspec
-import Text.Parser.Combinators (eof)
+import Text.Megaparsec (SourcePos, eof, skipMany, spaceChar)
 
 import TestUtils
 
@@ -17,8 +21,41 @@
 spec = describe "Parser" $ do
 
     it "can parse empty documents" $
-        assertParses P.program (T.Program [] []) ""
+        parseSuccessCases P.program $ map (, T.Program [] [])
+            [ ""
+            , "// line comment at EOF"
+            , "# line comment at EOF\n"
+            , "/** docstring at EOF */"
+            , "/** docstring with space\nand newline at EOF\n\t\t*/ "
+            , "/* comment\n\tat eof\n\t */"
+            ]
 
+    it "can parse docstrings" $ forM_
+        [ ( return "/** foo */", "foo " )
+        , ( return "/** foo\n */", "foo" )
+        , ( readFile "test/data/docstring-1.txt"
+          , "Hello. This is the first\n" ++
+            "paragraph.\n\n" ++
+            "    This is some text indented 4 spaces,\n" ++
+            "    spread across multiple lines.\n\n" ++
+            "Back."
+          )
+        , ( readFile "test/data/docstring-2.txt"
+          , "The docstring itself is indented 4 spaces.\n\n" ++
+            "And has a missing * in between."
+          )
+        ] $ \(i, o) -> do
+            input <- i
+            assertParses (skipMany spaceChar *> P.docstring) (pack o) input
+
+    it "can parse basic constants" $ parseSuccessCases P.constantValue
+        [ ("42", T.ConstInt 42 ())
+        , ("0x2a", T.ConstInt 42 ())
+        , ("1.2", T.ConstFloat 1.2 ())
+        , ("foo", T.ConstIdentifier "foo" ())
+        , ("\"foo\"", T.ConstLiteral "foo" ())
+        ]
+
     testParseFailure
 
 testParseFailure :: Spec
@@ -45,3 +82,9 @@
 
 parseFailureCases :: Show a => Parser a -> [String] -> Expectation
 parseFailureCases p = mapM_ (p `shouldNotParse`)
+
+parseSuccessCases
+    :: (Show (a ()), Eq (a ()), Functor a)
+    => Parser (a SourcePos) -> [(String, a ())] -> Expectation
+parseSuccessCases parser = mapM_ $ \(input, value) ->
+    assertParses (void `fmap` parser) value input
diff --git a/test/Language/Thrift/TypesSpec.hs b/test/Language/Thrift/TypesSpec.hs
--- a/test/Language/Thrift/TypesSpec.hs
+++ b/test/Language/Thrift/TypesSpec.hs
@@ -1,80 +1,69 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Language.Thrift.TypesSpec (spec) where
 
+import Control.Monad         (void)
 import Test.Hspec
 import Test.Hspec.QuickCheck
-import Text.Parser.Token     (whiteSpace)
+import Text.Megaparsec       (SourcePos)
 
-import qualified Text.PrettyPrint.ANSI.Leijen as PPA (Doc, plain)
-import qualified Text.PrettyPrint.Leijen      as PP (Doc)
+import qualified Text.PrettyPrint.ANSI.Leijen as PP (Doc, plain)
 
 import Language.Thrift.Arbitrary ()
 import TestUtils
 
-import qualified Language.Thrift.Parser      as P
-import qualified Language.Thrift.Pretty      as PP
-import qualified Language.Thrift.Pretty.ANSI as PPA
+import qualified Language.Thrift.Parser as P
+import qualified Language.Thrift.Pretty as PP
 
 spec :: Spec
 spec =
     describe "Parser and Printer" $ do
 
         prop "can round-trip type references" $
-            roundtrip PP.typeReference PPA.typeReference P.typeReference
+            roundtrip PP.typeReference P.typeReference
 
         prop "can round-trip constant values" $
-            roundtrip PP.constantValue PPA.constantValue P.constantValue
+            roundtrip PP.constantValue P.constantValue
 
         prop "can round-trip typedefs" $
-            roundtrip PP.typedef PPA.typedef (whiteSpace >> P.typedef)
+            roundtrip PP.typedef (P.whiteSpace >> P.typedef)
 
         prop "can round-trip enums" $
-            roundtrip PP.enum PPA.enum (whiteSpace >> P.enum)
+            roundtrip PP.enum (P.whiteSpace >> P.enum)
 
         prop "can round-trip structs" $
-            roundtrip PP.struct PPA.struct (whiteSpace >> P.struct)
+            roundtrip PP.struct (P.whiteSpace >> P.struct)
 
         prop "can round-trip unions" $
-            roundtrip PP.union PPA.union (whiteSpace >> P.union)
+            roundtrip PP.union (P.whiteSpace >> P.union)
 
         prop "can round-trip exceptions" $
-            roundtrip PP.exception PPA.exception (whiteSpace >> P.exception)
+            roundtrip PP.exception (P.whiteSpace >> P.exception)
 
         prop "can round-trip senums" $
-            roundtrip PP.senum PPA.senum (whiteSpace >> P.senum)
+            roundtrip PP.senum (P.whiteSpace >> P.senum)
 
         prop "can round-trip services" $
-            roundtrip PP.service PPA.service (whiteSpace >> P.service)
+            roundtrip PP.service (P.whiteSpace >> P.service)
 
         prop "can round-trip constants" $
-            roundtrip PP.constant PPA.constant (whiteSpace >> P.constant)
+            roundtrip PP.constant (P.whiteSpace >> P.constant)
 
         prop "can round-trip includes" $
-            roundtrip
-                (const PP.include)
-                (const PPA.include)
-                (whiteSpace >> P.include)
+            roundtrip (const PP.include) (P.whiteSpace >> P.include)
 
         prop "can round-trip namespaces" $
-            roundtrip
-                (const PP.namespace)
-                (const PPA.namespace)
-                (whiteSpace >> P.namespace)
+            roundtrip (const PP.namespace) (P.whiteSpace >> P.namespace)
 
         prop "can round-trip documents" $
-            roundtrip PP.program PPA.program P.program
+            roundtrip PP.program P.program
 
 
 roundtrip
-    :: (Show a, Eq a)
-    => (PP.Config  -> a ->  PP.Doc)
-    -> (PPA.Config -> a -> PPA.Doc)
-    ->  Parser a   -> a -> IO ()
-roundtrip printer ansiPrinter parser value = do
-    assertParses parser value
-        (show $ printer (PP.Config 4) value)
-
-    -- For the ANSI pretty printer, we need to discard the color information
-    -- for the document to be parseable.
-    assertParses parser value
-        (show . PPA.plain $ ansiPrinter (PPA.Config 4) value)
+    :: (Show (n ()), Eq (n ()), Functor n)
+    => (PP.Config  -> n () ->  PP.Doc)
+    -> Parser (n SourcePos)
+    -> n ()
+    -> IO ()
+roundtrip printer parser value =
+    assertParses (void `fmap` parser) value
+        (show . PP.plain $ printer (PP.Config 4) value)
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -7,5 +7,5 @@
 main :: IO ()
 main =
     hspecWith
-        defaultConfig { configQuickCheckMaxSize = Just 25 }
+        defaultConfig { configQuickCheckMaxSize = Just 30 }
         Spec.spec
diff --git a/test/TestUtils.hs b/test/TestUtils.hs
--- a/test/TestUtils.hs
+++ b/test/TestUtils.hs
@@ -5,40 +5,40 @@
     , Parser
     ) where
 
-import Test.Hspec (expectationFailure, shouldBe)
-
-import qualified Text.Trifecta       as T
-import qualified Text.Trifecta.Delta as T
+import Control.Monad (when)
+import Test.Hspec    (expectationFailure)
 
-import qualified Language.Thrift.Parser as P
+import qualified Language.Thrift.Parser as T
+import qualified Text.Megaparsec        as P
 
-type Parser a = P.ThriftParser T.Parser () a
+type Parser = T.Parser String
 
-parse :: Parser a -> String -> T.Result a
-parse parser = T.parseString trifectaParser (T.Directed "memory" 0 0 0 0)
-  where
-    trifectaParser = P.runThriftParser (return ()) parser
+parse :: Parser a -> String -> Either P.ParseError a
+parse parser = P.parse (T.runParser parser) "memory"
 
 -- | @assertParses parser expected input@ will assert that running @parser@ on
 -- @input@ will produce @expected@.
 assertParses :: (Show a, Eq a) => Parser a -> a -> String -> IO ()
 assertParses parser expected input =
     case parse parser input of
-        T.Success got -> got `shouldBe` expected
-        T.Failure msg -> expectationFailure $
+        Right got -> when (got /= expected) $ expectationFailure $
+            "\n\texpected: " ++ show expected ++
+            "\n\tgot: " ++ show got ++
+            "\n\tin:\n" ++ indent 8 input
+        Left err -> expectationFailure $
             "failed to parse:\n" ++ indent 8 input ++
             "\n\texpected: " ++ show expected ++
-            "\n\tgot (error): " ++ show msg
+            "\n\tgot (error): " ++ show err
 
 -- | @parser `shouldNotParse` input@ will assert that running @parser@ on
 -- @input@ will fail.
 shouldNotParse :: Show a => Parser a -> String -> IO ()
 shouldNotParse parser input =
     case parse parser input of
-        T.Success result -> expectationFailure $
+        Right result -> expectationFailure $
             "expected parse failure for\n" ++ indent 8 input ++
             "\n\tgot success: " ++ show result
-        T.Failure _ -> return ()
+        Left _ -> return ()
 
 
 -- | Indent all lines in the string the given number of spaces.
diff --git a/test/data/docstring-1.txt b/test/data/docstring-1.txt
new file mode 100644
--- /dev/null
+++ b/test/data/docstring-1.txt
@@ -0,0 +1,9 @@
+/**
+ * Hello. This is the first
+ * paragraph.
+ *
+ *     This is some text indented 4 spaces,
+ *     spread across multiple lines.
+ *
+ * Back.
+ */
diff --git a/test/data/docstring-2.txt b/test/data/docstring-2.txt
new file mode 100644
--- /dev/null
+++ b/test/data/docstring-2.txt
@@ -0,0 +1,5 @@
+    /**
+     * The docstring itself is indented 4 spaces.
+
+     * And has a missing * in between.
+     */
