content: module Language.PureScript.Docs.Types
    ( module Language.PureScript.Docs.Types
    , module ReExports
    )
    where
  
  import Protolude hiding (to, from, unlines)
  import Prelude (String, unlines, lookup)
  
  import Control.Arrow ((***))
  
  import Data.Aeson ((.=))
  import Data.Aeson.Key qualified as A.Key
  import Data.Aeson.BetterErrors
    (Parse, keyOrDefault, throwCustomError, key, asText,
     keyMay, withString, eachInArray, asNull, (.!), toAesonParser, toAesonParser',
     fromAesonParser, perhaps, withText, asIntegral, nth, eachInObjectWithKey,
     asString)
  import Data.Map qualified as Map
  import Data.Time.Clock (UTCTime)
  import Data.Time.Format qualified as TimeFormat
  import Data.Version (Version(..), showVersion)
  import Data.Aeson qualified as A
  import Data.Text qualified as T
  import Data.Vector qualified as V
  
  import Language.PureScript.AST qualified as P
  import Language.PureScript.CoreFn.FromJSON qualified as P
  import Language.PureScript.Crash qualified as P
  import Language.PureScript.Environment qualified as P
  import Language.PureScript.Names qualified as P
  import Language.PureScript.Roles qualified as P
  import Language.PureScript.Types qualified as P
  import Paths_purescript qualified as Paths
  
  import Web.Bower.PackageMeta (BowerError, PackageMeta(..), PackageName, asPackageMeta, parsePackageName, runPackageName, showBowerError)
  
  import Language.PureScript.Docs.RenderedCode as ReExports
    (RenderedCode,
     ContainingModule(..), asContainingModule,
     RenderedCodeElement(..),
     Namespace(..), FixityAlias)
  import Language.PureScript.Publish.Registry.Compat (PursJsonError, showPursJsonError)
  
  type Type' = P.Type ()
  type Constraint' = P.Constraint ()
  
  --------------------
  -- Types
  
  data Package a = Package
    { pkgMeta                 :: PackageMeta
    , pkgVersion              :: Version
    , pkgVersionTag           :: Text
    -- TODO: When this field was introduced, it was given the Maybe type for the
    -- sake of backwards compatibility, as older JSON blobs will not include the
    -- field. It should eventually be changed to just UTCTime.
    , pkgTagTime              :: Maybe UTCTime
    , pkgModules              :: [Module]
    , pkgModuleMap            :: Map P.ModuleName PackageName
    , pkgResolvedDependencies :: [(PackageName, Version)]
    , pkgGithub               :: (GithubUser, GithubRepo)
    , pkgUploader             :: a
    , pkgCompilerVersion      :: Version
      -- ^ The version of the PureScript compiler which was used to generate
      -- this data. We store this in order to reject packages which are too old.
    }
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData a => NFData (Package a)
  
  data NotYetKnown = NotYetKnown
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData NotYetKnown
  
  type UploadedPackage = Package NotYetKnown
  type VerifiedPackage = Package GithubUser
  
  data ManifestError
    = BowerManifest BowerError
    | PursManifest PursJsonError
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData ManifestError
  
  showManifestError :: ManifestError -> Text
  showManifestError = \case
    BowerManifest err -> showBowerError err
    PursManifest err -> showPursJsonError err
  
  verifyPackage :: GithubUser -> UploadedPackage -> VerifiedPackage
  verifyPackage verifiedUser Package{..} =
    Package pkgMeta
            pkgVersion
            pkgVersionTag
            pkgTagTime
            pkgModules
            pkgModuleMap
            pkgResolvedDependencies
            pkgGithub
            verifiedUser
            pkgCompilerVersion
  
  packageName :: Package a -> PackageName
  packageName = bowerName . pkgMeta
  
  -- |
  -- The time format used for serializing package tag times in the JSON format.
  -- This is the ISO 8601 date format which includes a time and a timezone.
  --
  jsonTimeFormat :: String
  jsonTimeFormat = "%Y-%m-%dT%H:%M:%S%z"
  
  -- |
  -- Convenience function for formatting a time in the format expected by this
  -- module.
  --
  formatTime :: UTCTime -> String
  formatTime =
    TimeFormat.formatTime TimeFormat.defaultTimeLocale jsonTimeFormat
  
  -- |
  -- Convenience function for parsing a time in the format expected by this
  -- module.
  --
  parseTime :: String -> Maybe UTCTime
  parseTime =
    TimeFormat.parseTimeM False TimeFormat.defaultTimeLocale jsonTimeFormat
  
  data Module = Module
    { modName         :: P.ModuleName
    , modComments     :: Maybe Text
    , modDeclarations :: [Declaration]
    -- Re-exported values from other modules
    , modReExports    :: [(InPackage P.ModuleName, [Declaration])]
    }
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData Module
  
  data Declaration = Declaration
    { declTitle      :: Text
    , declComments   :: Maybe Text
    , declSourceSpan :: Maybe P.SourceSpan
    , declChildren   :: [ChildDeclaration]
    , declInfo       :: DeclarationInfo
    , declKind       :: Maybe KindInfo
    }
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData Declaration
  
  -- |
  -- A value of this type contains information that is specific to a particular
  -- kind of declaration (as opposed to information which exists in all kinds of
  -- declarations, which goes into the 'Declaration' type directly).
  --
  -- Many of the constructors are very similar to their equivalents in the real
  -- PureScript AST, except that they have their name elided, since this is
  -- already available via the rdTitle field of 'Declaration'.
  --
  data DeclarationInfo
    -- |
    -- A value declaration, with its type.
    --
    = ValueDeclaration Type'
  
    -- |
    -- A data/newtype declaration, with the kind of declaration (data or
    -- newtype) and its type arguments. Constructors are represented as child
    -- declarations.
    --
    | DataDeclaration P.DataDeclType [(Text, Maybe Type')] [P.Role]
  
    -- |
    -- A data type foreign import, with its kind.
    --
    | ExternDataDeclaration Type' [P.Role]
  
    -- |
    -- A type synonym, with its type arguments and its type.
    --
    | TypeSynonymDeclaration [(Text, Maybe Type')] Type'
  
    -- |
    -- A type class, with its type arguments, its superclasses and functional
    -- dependencies. Instances and members are represented as child declarations.
    --
    | TypeClassDeclaration [(Text, Maybe Type')] [Constraint'] [([Text], [Text])]
  
    -- |
    -- An operator alias declaration, with the member the alias is for and the
    -- operator's fixity.
    --
    | AliasDeclaration P.Fixity FixityAlias
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData DeclarationInfo
  
  -- |
  -- Wraps enough information to properly render the kind signature
  -- of a data/newtype/type/class declaration.
  data KindInfo = KindInfo
    { kiKeyword :: P.KindSignatureFor
    , kiKind :: Type'
    }
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData KindInfo
  
  convertFundepsToStrings :: [(Text, Maybe Type')] -> [P.FunctionalDependency] -> [([Text], [Text])]
  convertFundepsToStrings args fundeps =
    map (\(P.FunctionalDependency from to) -> toArgs from to) fundeps
    where
    argsVec = V.fromList (map fst args)
    getArg i =
      fromMaybe
        (P.internalError $ unlines
          [ "convertDeclaration: Functional dependency index"
          , show i
          , "is bigger than arguments list"
          , show (map fst args)
          , "Functional dependencies are"
          , show fundeps
          ]
        ) $ argsVec V.!? i
    toArgs from to = (map getArg from, map getArg to)
  
  declInfoToString :: DeclarationInfo -> Text
  declInfoToString (ValueDeclaration _) = "value"
  declInfoToString (DataDeclaration _ _ _) = "data"
  declInfoToString (ExternDataDeclaration _ _) = "externData"
  declInfoToString (TypeSynonymDeclaration _ _) = "typeSynonym"
  declInfoToString (TypeClassDeclaration _ _ _) = "typeClass"
  declInfoToString (AliasDeclaration _ _) = "alias"
  
  declInfoNamespace :: DeclarationInfo -> Namespace
  declInfoNamespace = \case
    ValueDeclaration{} ->
      ValueLevel
    DataDeclaration{} ->
      TypeLevel
    ExternDataDeclaration{} ->
      TypeLevel
    TypeSynonymDeclaration{} ->
      TypeLevel
    TypeClassDeclaration{} ->
      TypeLevel
    AliasDeclaration _ alias ->
      either (const TypeLevel) (const ValueLevel) (P.disqualify alias)
  
  isTypeClass :: Declaration -> Bool
  isTypeClass Declaration{..} =
    case declInfo of
      TypeClassDeclaration{} -> True
      _ -> False
  
  isValue :: Declaration -> Bool
  isValue Declaration{..} =
    case declInfo of
      ValueDeclaration{} -> True
      _ -> False
  
  isType :: Declaration ->  Bool
  isType Declaration{..} =
    case declInfo of
      TypeSynonymDeclaration{} -> True
      DataDeclaration{} -> True
      ExternDataDeclaration{} -> True
      _ -> False
  
  isValueAlias :: Declaration -> Bool
  isValueAlias Declaration{..} =
    case declInfo of
      AliasDeclaration _ (P.Qualified _ d) -> isRight d
      _ -> False
  
  isTypeAlias :: Declaration -> Bool
  isTypeAlias Declaration{..} =
    case declInfo of
      AliasDeclaration _ (P.Qualified _ d) -> isLeft d
      _ -> False
  
  -- | Discard any children which do not satisfy the given predicate.
  filterChildren :: (ChildDeclaration -> Bool) -> Declaration -> Declaration
  filterChildren p decl =
    decl { declChildren = filter p (declChildren decl) }
  
  data ChildDeclaration = ChildDeclaration
    { cdeclTitle      :: Text
    , cdeclComments   :: Maybe Text
    , cdeclSourceSpan :: Maybe P.SourceSpan
    , cdeclInfo       :: ChildDeclarationInfo
    }
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData ChildDeclaration
  
  data ChildDeclarationInfo
    -- |
    -- A type instance declaration, with its dependencies and its type.
    --
    = ChildInstance [Constraint'] Type'
  
    -- |
    -- A data constructor, with its type arguments.
    --
    | ChildDataConstructor [Type']
  
    -- |
    -- A type class member, with its type. Note that the type does not include
    -- the type class constraint; this may be added manually if desired. For
    -- example, `pure` from `Applicative` would be `forall a. a -> f a`.
    --
    | ChildTypeClassMember Type'
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData ChildDeclarationInfo
  
  childDeclInfoToString :: ChildDeclarationInfo -> Text
  childDeclInfoToString (ChildInstance _ _)      = "instance"
  childDeclInfoToString (ChildDataConstructor _) = "dataConstructor"
  childDeclInfoToString (ChildTypeClassMember _) = "typeClassMember"
  
  childDeclInfoNamespace :: ChildDeclarationInfo -> Namespace
  childDeclInfoNamespace =
    -- We could just write this as `const ValueLevel` but by doing it this way,
    -- if another constructor is added, we get a warning which acts as a prompt
    -- to update this, instead of having this function (possibly incorrectly)
    -- just return ValueLevel for the new constructor.
    \case
      ChildInstance{} ->
        ValueLevel
      ChildDataConstructor{} ->
        ValueLevel
      ChildTypeClassMember{} ->
        ValueLevel
  
  isTypeClassMember :: ChildDeclaration -> Bool
  isTypeClassMember ChildDeclaration{..} =
    case cdeclInfo of
      ChildTypeClassMember{} -> True
      _ -> False
  
  isDataConstructor :: ChildDeclaration -> Bool
  isDataConstructor ChildDeclaration{..} =
    case cdeclInfo of
      ChildDataConstructor{} -> True
      _ -> False
  
  newtype GithubUser
    = GithubUser { runGithubUser :: Text }
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData GithubUser
  
  newtype GithubRepo
    = GithubRepo { runGithubRepo :: Text }
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData GithubRepo
  
  data PackageError
    = CompilerTooOld Version Version
        -- ^ Minimum allowable version for generating data with the current
        -- parser, and actual version used.
    | ErrorInPackageMeta ManifestError
    | InvalidVersion
    | InvalidDeclarationType Text
    | InvalidChildDeclarationType Text
    | InvalidFixity
    | InvalidKind Text
    | InvalidDataDeclType Text
    | InvalidKindSignatureFor Text
    | InvalidTime
    | InvalidRole Text
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData PackageError
  
  data InPackage a
    = Local a
    | FromDep PackageName a
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData a => NFData (InPackage a)
  
  instance Functor InPackage where
    fmap f (Local x) = Local (f x)
    fmap f (FromDep pkgName x) = FromDep pkgName (f x)
  
  ignorePackage :: InPackage a -> a
  ignorePackage (Local x) = x
  ignorePackage (FromDep _ x) = x
  
  ----------------------------------------------------
  -- Types for links between declarations
  
  data LinksContext = LinksContext
    { ctxGithub               :: (GithubUser, GithubRepo)
    , ctxModuleMap            :: Map P.ModuleName PackageName
    , ctxResolvedDependencies :: [(PackageName, Version)]
    , ctxPackageName          :: PackageName
    , ctxVersion              :: Version
    , ctxVersionTag           :: Text
    }
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData LinksContext
  
  data DocLink = DocLink
    { linkLocation  :: LinkLocation
    , linkTitle     :: Text
    , linkNamespace :: Namespace
    }
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData DocLink
  
  data LinkLocation
    -- | A link to a declaration in the current package.
    = LocalModule P.ModuleName
  
    -- | A link to a declaration in a different package. The arguments represent
    -- the name of the other package, the version of the other package, and the
    -- name of the module in the other package that the declaration is in.
    | DepsModule PackageName Version P.ModuleName
  
    -- | A link to a declaration that is built in to the compiler, e.g. the Prim
    -- module. In this case we only need to store the module that the builtin
    -- comes from. Note that all builtin modules begin with "Prim", and that the
    -- compiler rejects attempts to define modules whose names start with "Prim".
    | BuiltinModule P.ModuleName
    deriving (Show, Eq, Ord, Generic)
  
  instance NFData LinkLocation
  
  -- | Given a links context, the current module name, the namespace of a thing
  -- to link to, its title, and its containing module, attempt to create a
  -- DocLink.
  getLink :: LinksContext -> P.ModuleName -> Namespace -> Text -> ContainingModule -> Maybe DocLink
  getLink LinksContext{..} curMn namespace target containingMod = do
    location <- getLinkLocation
    return DocLink
      { linkLocation = location
      , linkTitle = target
      , linkNamespace = namespace
      }
  
    where
    getLinkLocation = builtinLinkLocation <|> normalLinkLocation
  
    normalLinkLocation = do
      case containingMod of
        ThisModule ->
          return $ LocalModule curMn
        OtherModule destMn ->
          case Map.lookup destMn ctxModuleMap of
            Nothing ->
              return $ LocalModule destMn
            Just pkgName -> do
              pkgVersion <- lookup pkgName ctxResolvedDependencies
              return $ DepsModule pkgName pkgVersion destMn
  
    builtinLinkLocation =
      case containingMod of
        OtherModule mn | P.isBuiltinModuleName mn ->
          pure $ BuiltinModule mn
        _ ->
          empty
  
  getLinksContext :: Package a -> LinksContext
  getLinksContext Package{..} =
    LinksContext
      { ctxGithub               = pkgGithub
      , ctxModuleMap            = pkgModuleMap
      , ctxResolvedDependencies = pkgResolvedDependencies
      , ctxPackageName          = bowerName pkgMeta
      , ctxVersion              = pkgVersion
      , ctxVersionTag           = pkgVersionTag
      }
  
  ----------------------
  -- Parsing
  
  asPackage :: Version -> (forall e. Parse e a) -> Parse PackageError (Package a)
  asPackage minimumVersion uploader = do
    -- If the compilerVersion key is missing, we can be sure that it was produced
    -- with 0.7.0.0, since that is the only released version that included the
    -- `psc-publish` tool (now `purs publish`) before this key was added.
    compilerVersion <- keyOrDefault "compilerVersion" (Version [0,7,0,0] []) asVersion
    when (compilerVersion < minimumVersion)
      (throwCustomError $ CompilerTooOld minimumVersion compilerVersion)
  
    Package <$> key "packageMeta" asPackageMeta .! (ErrorInPackageMeta . BowerManifest)
            <*> key "version" asVersion
            <*> key "versionTag" asText
            <*> keyMay "tagTime" (withString parseTimeEither)
            <*> key "modules" (eachInArray asModule)
            <*> moduleMap
            <*> key "resolvedDependencies" asResolvedDependencies
            <*> key "github" asGithub
            <*> key "uploader" uploader
            <*> pure compilerVersion
    where
    moduleMap =
      key "moduleMap" asModuleMap
      `pOr` (key "bookmarks" bookmarksAsModuleMap .! ErrorInPackageMeta)
  
  parseTimeEither :: String -> Either PackageError UTCTime
  parseTimeEither =
    maybe (Left InvalidTime) Right . parseTime
  
  asUploadedPackage :: Version -> Parse PackageError UploadedPackage
  asUploadedPackage minVersion = asPackage minVersion asNotYetKnown
  
  asNotYetKnown :: Parse e NotYetKnown
  asNotYetKnown = NotYetKnown <$ asNull
  
  instance A.FromJSON NotYetKnown where
    parseJSON = toAesonParser' asNotYetKnown
  
  displayPackageError :: PackageError -> Text
  displayPackageError e = case e of
    CompilerTooOld minV usedV ->
      "Expecting data produced by at least version " <> T.pack (showVersion minV)
      <> " of the compiler, but it appears that " <> T.pack (showVersion usedV)
      <> " was used."
    ErrorInPackageMeta err ->
      "Error in package metadata: " <> showManifestError err
    InvalidVersion ->
      "Invalid version"
    InvalidDeclarationType str ->
      "Invalid declaration type: \"" <> str <> "\""
    InvalidChildDeclarationType str ->
      "Invalid child declaration type: \"" <> str <> "\""
    InvalidFixity ->
      "Invalid fixity"
    InvalidKind str ->
      "Invalid kind: \"" <> str <> "\""
    InvalidDataDeclType str ->
      "Invalid data declaration type: \"" <> str <> "\""
    InvalidKindSignatureFor str ->
      "Invalid kind signature keyword: \"" <> str <> "\""
    InvalidTime ->
      "Invalid time"
    InvalidRole str ->
      "Invalid role keyword: \"" <> str <> "\""
  
  instance A.FromJSON a => A.FromJSON (Package a) where
    parseJSON = toAesonParser displayPackageError
                              (asPackage (Version [0,0,0,0] []) fromAesonParser)
  
  asGithubUser :: Parse e GithubUser
  asGithubUser = GithubUser <$> asText
  
  instance A.FromJSON GithubUser where
    parseJSON = toAesonParser' asGithubUser
  
  asVersion :: Parse PackageError Version
  asVersion = withString (maybe (Left InvalidVersion) Right . P.parseVersion')
  
  asModule :: Parse PackageError Module
  asModule =
    Module <$> key "name" (P.moduleNameFromString <$> asText)
           <*> key "comments" (perhaps asText)
           <*> key "declarations" (eachInArray asDeclaration)
           <*> key "reExports" (eachInArray asReExport)
  
  asDeclaration :: Parse PackageError Declaration
  asDeclaration =
    Declaration <$> key "title" asText
                <*> key "comments" (perhaps asText)
                <*> key "sourceSpan" (perhaps asSourceSpan)
                <*> key "children" (eachInArray asChildDeclaration)
                <*> key "info" asDeclarationInfo
                <*> keyOrDefault "kind" Nothing (perhaps asKindInfo)
  
  asReExport :: Parse PackageError (InPackage P.ModuleName, [Declaration])
  asReExport =
    (,) <$> key "moduleName" asReExportModuleName
        <*> key "declarations" (eachInArray asDeclaration)
    where
    -- This is to preserve backwards compatibility with 0.10.3 and earlier versions
    -- of the compiler, where the modReExports field had the type
    -- [(P.ModuleName, [Declaration])]. This should eventually be removed,
    -- possibly at the same time as the next breaking change to this JSON format.
    asReExportModuleName :: Parse PackageError (InPackage P.ModuleName)
    asReExportModuleName =
      asInPackage fromAesonParser .! ErrorInPackageMeta
      `pOr` fmap Local fromAesonParser
  
  pOr :: Parse e a -> Parse e a -> Parse e a
  p `pOr` q = catchError p (const q)
  
  asInPackage :: Parse ManifestError a -> Parse ManifestError (InPackage a)
  asInPackage inner =
    build <$> key "package" (perhaps (withText (mapLeft BowerManifest . parsePackageName)))
          <*> key "item" inner
    where
    build Nothing = Local
    build (Just pn) = FromDep pn
  
  asFixity :: Parse PackageError P.Fixity
  asFixity =
    P.Fixity <$> key "associativity" asAssociativity
             <*> key "precedence" asIntegral
  
  asFixityAlias :: Parse PackageError FixityAlias
  asFixityAlias = fromAesonParser
  
  parseAssociativity :: String -> Maybe P.Associativity
  parseAssociativity str = case str of
    "infix"  -> Just P.Infix
    "infixl" -> Just P.Infixl
    "infixr" -> Just P.Infixr
    _        -> Nothing
  
  asAssociativity :: Parse PackageError P.Associativity
  asAssociativity = withString (maybe (Left InvalidFixity) Right . parseAssociativity)
  
  asDeclarationInfo :: Parse PackageError DeclarationInfo
  asDeclarationInfo = do
    ty <- key "declType" asText
    case ty of
      "value" ->
        ValueDeclaration <$> key "type" asType
      "data" ->
        DataDeclaration <$> key "dataDeclType" asDataDeclType
                        <*> key "typeArguments" asTypeArguments
                        <*> keyOrDefault "roles" [] (eachInArray asRole)
      "externData" ->
        ExternDataDeclaration <$> key "kind" asType
                              <*> keyOrDefault "roles" [] (eachInArray asRole)
      "typeSynonym" ->
        TypeSynonymDeclaration <$> key "arguments" asTypeArguments
                               <*> key "type" asType
      "typeClass" ->
        TypeClassDeclaration <$> key "arguments" asTypeArguments
                             <*> key "superclasses" (eachInArray asConstraint)
                             <*> keyOrDefault "fundeps" [] asFunDeps
      "alias" ->
        AliasDeclaration <$> key "fixity" asFixity
                         <*> key "alias" asFixityAlias
      -- Backwards compat: kinds are extern data
      "kind" ->
        pure $ ExternDataDeclaration (P.kindType $> ()) []
      other ->
        throwCustomError (InvalidDeclarationType other)
  
  asKindInfo :: Parse PackageError KindInfo
  asKindInfo =
    KindInfo <$> key "keyword" asKindSignatureFor
             <*> key "kind" asType
  
  asKindSignatureFor :: Parse PackageError P.KindSignatureFor
  asKindSignatureFor =
    withText $ \case
      "data" -> Right P.DataSig
      "newtype" -> Right P.NewtypeSig
      "class" -> Right P.ClassSig
      "type" -> Right P.TypeSynonymSig
      x -> Left (InvalidKindSignatureFor x)
  
  asTypeArguments :: Parse PackageError [(Text, Maybe Type')]
  asTypeArguments = eachInArray asTypeArgument
    where
    asTypeArgument = (,) <$> nth 0 asText <*> nth 1 (perhaps asType)
  
  asRole :: Parse PackageError P.Role
  asRole =
    withText $ \case
      "Representational" -> Right P.Representational
      "Nominal" -> Right P.Nominal
      "Phantom" -> Right P.Phantom
      other -> Left (InvalidRole other)
  
  asType :: Parse e Type'
  asType = fromAesonParser
  
  asFunDeps :: Parse PackageError [([Text], [Text])]
  asFunDeps = eachInArray asFunDep
    where
    asFunDep = (,) <$> nth 0 (eachInArray asText) <*> nth 1 (eachInArray asText)
  
  asDataDeclType :: Parse PackageError P.DataDeclType
  asDataDeclType =
    withText $ \case
      "data"    -> Right P.Data
      "newtype" -> Right P.Newtype
      other     -> Left (InvalidDataDeclType other)
  
  asChildDeclaration :: Parse PackageError ChildDeclaration
  asChildDeclaration =
    ChildDeclaration <$> key "title" asText
                             <*> key "comments" (perhaps asText)
                             <*> key "sourceSpan" (perhaps asSourceSpan)
                             <*> key "info" asChildDeclarationInfo
  
  asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo
  asChildDeclarationInfo = do
    ty <- key "declType" asText
    case ty of
      "instance" ->
        ChildInstance <$> key "dependencies" (eachInArray asConstraint)
                      <*> key "type" asType
      "dataConstructor" ->
        ChildDataConstructor <$> key "arguments" (eachInArray asType)
      "typeClassMember" ->
        ChildTypeClassMember <$> key "type" asType
      other ->
        throwCustomError $ InvalidChildDeclarationType other
  
  asSourcePos :: Parse e P.SourcePos
  asSourcePos = P.SourcePos <$> nth 0 asIntegral
                            <*> nth 1 asIntegral
  
  asConstraint :: Parse PackageError Constraint'
  asConstraint = P.Constraint () <$> key "constraintClass" asQualifiedProperName
                                 <*> keyOrDefault "constraintKindArgs" [] (eachInArray asType)
                                 <*> key "constraintArgs" (eachInArray asType)
                                 <*> pure Nothing
  
  asQualifiedProperName :: Parse e (P.Qualified (P.ProperName a))
  asQualifiedProperName = fromAesonParser
  
  asModuleMap :: Parse PackageError (Map P.ModuleName PackageName)
  asModuleMap =
    Map.fromList <$>
      eachInObjectWithKey (Right . P.moduleNameFromString)
                          (withText parsePackageName')
  
  -- This is here to preserve backwards compatibility with compilers which used
  -- to generate a 'bookmarks' field in the JSON (i.e. up to 0.10.5). We should
  -- remove this after the next breaking change to the JSON.
  bookmarksAsModuleMap :: Parse ManifestError (Map P.ModuleName PackageName)
  bookmarksAsModuleMap =
    convert <$>
      eachInArray (asInPackage (nth 0 (P.moduleNameFromString <$> asText)))
  
    where
    convert :: [InPackage P.ModuleName] -> Map P.ModuleName PackageName
    convert = Map.fromList . mapMaybe toTuple
  
    toTuple (Local _) = Nothing
    toTuple (FromDep pkgName mn) = Just (mn, pkgName)
  
  asResolvedDependencies :: Parse PackageError [(PackageName, Version)]
  asResolvedDependencies =
    eachInObjectWithKey parsePackageName' asVersion
  
  parsePackageName' :: Text -> Either PackageError PackageName
  parsePackageName' =
    mapLeft ErrorInPackageMeta . (mapLeft BowerManifest . parsePackageName)
  
  mapLeft :: (a -> a') -> Either a b -> Either a' b
  mapLeft f (Left x) = Left (f x)
  mapLeft _ (Right x) = Right x
  
  asGithub :: Parse e (GithubUser, GithubRepo)
  asGithub = (,) <$> nth 0 (GithubUser <$> asText)
                 <*> nth 1 (GithubRepo <$> asText)
  
  asSourceSpan :: Parse e P.SourceSpan
  asSourceSpan = P.SourceSpan <$> key "name" asString
                              <*> key "start" asSourcePos
                              <*> key "end" asSourcePos
  
  ---------------------
  -- ToJSON instances
  
  instance A.ToJSON a => A.ToJSON (Package a) where
    toJSON Package{..} =
      A.object $
        [ "packageMeta"          .= pkgMeta
        , "version"              .= showVersion pkgVersion
        , "versionTag"           .= pkgVersionTag
        , "modules"              .= pkgModules
        , "moduleMap"            .= assocListToJSON (A.Key.fromText . P.runModuleName)
                                                    runPackageName
                                                    (Map.toList pkgModuleMap)
        , "resolvedDependencies" .= assocListToJSON (A.Key.fromText . runPackageName)
                                                    (T.pack . showVersion)
                                                    pkgResolvedDependencies
        , "github"               .= pkgGithub
        , "uploader"             .= pkgUploader
        , "compilerVersion"      .= showVersion Paths.version
        ] ++
        fmap (\t -> "tagTime" .= formatTime t) (maybeToList pkgTagTime)
  
  instance A.ToJSON NotYetKnown where
    toJSON _ = A.Null
  
  instance A.ToJSON Module where
    toJSON Module{..} =
      A.object [ "name"         .= P.runModuleName modName
               , "comments"     .= modComments
               , "declarations" .= modDeclarations
               , "reExports"    .= map toObj modReExports
               ]
      where
      toObj (mn, decls) = A.object [ "moduleName" .= mn
                                   , "declarations" .= decls
                                   ]
  
  instance A.ToJSON Declaration where
    toJSON Declaration{..} =
      A.object [ "title"      .= declTitle
               , "comments"   .= declComments
               , "sourceSpan" .= declSourceSpan
               , "children"   .= declChildren
               , "info"       .= declInfo
               , "kind"       .= declKind
               ]
  
  instance A.ToJSON KindInfo where
   toJSON KindInfo{..} =
     A.object [ "keyword" .= kindSignatureForKeyword kiKeyword
              , "kind"    .= kiKind
              ]
  
  kindSignatureForKeyword :: P.KindSignatureFor -> Text
  kindSignatureForKeyword = \case
    P.DataSig -> "data"
    P.NewtypeSig -> "newtype"
    P.TypeSynonymSig -> "type"
    P.ClassSig -> "class"
  
  instance A.ToJSON ChildDeclaration where
    toJSON ChildDeclaration{..} =
      A.object [ "title"      .= cdeclTitle
               , "comments"   .= cdeclComments
               , "sourceSpan" .= cdeclSourceSpan
               , "info"       .= cdeclInfo
               ]
  
  instance A.ToJSON DeclarationInfo where
    toJSON info = A.object $ "declType" .= declInfoToString info : props
      where
      props = case info of
        ValueDeclaration ty -> ["type" .= ty]
        DataDeclaration ty args roles -> ["dataDeclType" .= ty, "typeArguments" .= args, "roles" .= roles]
        ExternDataDeclaration kind roles -> ["kind" .= kind, "roles" .= roles]
        TypeSynonymDeclaration args ty -> ["arguments" .= args, "type" .= ty]
        TypeClassDeclaration args super fundeps -> ["arguments" .= args, "superclasses" .= super, "fundeps" .= fundeps]
        AliasDeclaration fixity alias -> ["fixity" .= fixity, "alias" .= alias]
  
  instance A.ToJSON ChildDeclarationInfo where
    toJSON info = A.object $ "declType" .= childDeclInfoToString info : props
      where
      props = case info of
        ChildInstance deps ty     -> ["dependencies" .= deps, "type" .= ty]
        ChildDataConstructor args -> ["arguments" .= args]
        ChildTypeClassMember ty   -> ["type" .= ty]
  
  instance A.ToJSON GithubUser where
    toJSON = A.toJSON . runGithubUser
  
  instance A.ToJSON GithubRepo where
    toJSON = A.toJSON . runGithubRepo
  
  -- | Given a function for turning association list keys into JSON object keys,
  -- and a function for turning association list values to JSON string values,
  -- turns an association list into a JSON object.
  --
  -- For example:
  -- @assocListToJSON T.pack T.pack [("a", "b")]@ will give @{"a": "b"}@.
  assocListToJSON :: (a -> A.Key) -> (b -> Text) -> [(a, b)] -> A.Value
  assocListToJSON f g xs = A.object (map (uncurry (.=) . (f *** g)) xs)
  
  instance A.ToJSON a => A.ToJSON (InPackage a) where
    toJSON x =
      case x of
        Local y      -> withPackage (Nothing :: Maybe ()) y
        FromDep pn y -> withPackage (Just pn) y
      where
      withPackage :: (A.ToJSON p, A.ToJSON y) => p -> y -> A.Value
      withPackage p y =
        A.object [ "package" .= p
                 , "item"    .= y
                 ]
  