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
  { forall a. Package a -> PackageMeta
pkgMeta                 :: PackageMeta
  , forall a. Package a -> Version
pkgVersion              :: Version
  , forall a. Package a -> Text
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.
  , forall a. Package a -> Maybe UTCTime
pkgTagTime              :: Maybe UTCTime
  , forall a. Package a -> [Module]
pkgModules              :: [Module]
  , forall a. Package a -> Map ModuleName PackageName
pkgModuleMap            :: Map P.ModuleName PackageName
  , forall a. Package a -> [(PackageName, Version)]
pkgResolvedDependencies :: [(PackageName, Version)]
  , forall a. Package a -> (GithubUser, GithubRepo)
pkgGithub               :: (GithubUser, GithubRepo)
  , forall a. Package a -> a
pkgUploader             :: a
  , forall a. Package a -> Version
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 (Int -> Package a -> ShowS
forall a. Show a => Int -> Package a -> ShowS
forall a. Show a => [Package a] -> ShowS
forall a. Show a => Package a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package a] -> ShowS
$cshowList :: forall a. Show a => [Package a] -> ShowS
show :: Package a -> String
$cshow :: forall a. Show a => Package a -> String
showsPrec :: Int -> Package a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Package a -> ShowS
Show, Package a -> Package a -> Bool
forall a. Eq a => Package a -> Package a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package a -> Package a -> Bool
$c/= :: forall a. Eq a => Package a -> Package a -> Bool
== :: Package a -> Package a -> Bool
$c== :: forall a. Eq a => Package a -> Package a -> Bool
Eq, Package a -> Package a -> Bool
Package a -> Package a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Package a)
forall a. Ord a => Package a -> Package a -> Bool
forall a. Ord a => Package a -> Package a -> Ordering
forall a. Ord a => Package a -> Package a -> Package a
min :: Package a -> Package a -> Package a
$cmin :: forall a. Ord a => Package a -> Package a -> Package a
max :: Package a -> Package a -> Package a
$cmax :: forall a. Ord a => Package a -> Package a -> Package a
>= :: Package a -> Package a -> Bool
$c>= :: forall a. Ord a => Package a -> Package a -> Bool
> :: Package a -> Package a -> Bool
$c> :: forall a. Ord a => Package a -> Package a -> Bool
<= :: Package a -> Package a -> Bool
$c<= :: forall a. Ord a => Package a -> Package a -> Bool
< :: Package a -> Package a -> Bool
$c< :: forall a. Ord a => Package a -> Package a -> Bool
compare :: Package a -> Package a -> Ordering
$ccompare :: forall a. Ord a => Package a -> Package a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Package a) x -> Package a
forall a x. Package a -> Rep (Package a) x
$cto :: forall a x. Rep (Package a) x -> Package a
$cfrom :: forall a x. Package a -> Rep (Package a) x
Generic)

instance NFData a => NFData (Package a)

data NotYetKnown = NotYetKnown
  deriving (Int -> NotYetKnown -> ShowS
[NotYetKnown] -> ShowS
NotYetKnown -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotYetKnown] -> ShowS
$cshowList :: [NotYetKnown] -> ShowS
show :: NotYetKnown -> String
$cshow :: NotYetKnown -> String
showsPrec :: Int -> NotYetKnown -> ShowS
$cshowsPrec :: Int -> NotYetKnown -> ShowS
Show, NotYetKnown -> NotYetKnown -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotYetKnown -> NotYetKnown -> Bool
$c/= :: NotYetKnown -> NotYetKnown -> Bool
== :: NotYetKnown -> NotYetKnown -> Bool
$c== :: NotYetKnown -> NotYetKnown -> Bool
Eq, Eq NotYetKnown
NotYetKnown -> NotYetKnown -> Bool
NotYetKnown -> NotYetKnown -> Ordering
NotYetKnown -> NotYetKnown -> NotYetKnown
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NotYetKnown -> NotYetKnown -> NotYetKnown
$cmin :: NotYetKnown -> NotYetKnown -> NotYetKnown
max :: NotYetKnown -> NotYetKnown -> NotYetKnown
$cmax :: NotYetKnown -> NotYetKnown -> NotYetKnown
>= :: NotYetKnown -> NotYetKnown -> Bool
$c>= :: NotYetKnown -> NotYetKnown -> Bool
> :: NotYetKnown -> NotYetKnown -> Bool
$c> :: NotYetKnown -> NotYetKnown -> Bool
<= :: NotYetKnown -> NotYetKnown -> Bool
$c<= :: NotYetKnown -> NotYetKnown -> Bool
< :: NotYetKnown -> NotYetKnown -> Bool
$c< :: NotYetKnown -> NotYetKnown -> Bool
compare :: NotYetKnown -> NotYetKnown -> Ordering
$ccompare :: NotYetKnown -> NotYetKnown -> Ordering
Ord, forall x. Rep NotYetKnown x -> NotYetKnown
forall x. NotYetKnown -> Rep NotYetKnown x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotYetKnown x -> NotYetKnown
$cfrom :: forall x. NotYetKnown -> Rep NotYetKnown x
Generic)

instance NFData NotYetKnown

type UploadedPackage = Package NotYetKnown
type VerifiedPackage = Package GithubUser

data ManifestError
  = BowerManifest BowerError
  | PursManifest PursJsonError
  deriving (Int -> ManifestError -> ShowS
[ManifestError] -> ShowS
ManifestError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ManifestError] -> ShowS
$cshowList :: [ManifestError] -> ShowS
show :: ManifestError -> String
$cshow :: ManifestError -> String
showsPrec :: Int -> ManifestError -> ShowS
$cshowsPrec :: Int -> ManifestError -> ShowS
Show, ManifestError -> ManifestError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ManifestError -> ManifestError -> Bool
$c/= :: ManifestError -> ManifestError -> Bool
== :: ManifestError -> ManifestError -> Bool
$c== :: ManifestError -> ManifestError -> Bool
Eq, Eq ManifestError
ManifestError -> ManifestError -> Bool
ManifestError -> ManifestError -> Ordering
ManifestError -> ManifestError -> ManifestError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ManifestError -> ManifestError -> ManifestError
$cmin :: ManifestError -> ManifestError -> ManifestError
max :: ManifestError -> ManifestError -> ManifestError
$cmax :: ManifestError -> ManifestError -> ManifestError
>= :: ManifestError -> ManifestError -> Bool
$c>= :: ManifestError -> ManifestError -> Bool
> :: ManifestError -> ManifestError -> Bool
$c> :: ManifestError -> ManifestError -> Bool
<= :: ManifestError -> ManifestError -> Bool
$c<= :: ManifestError -> ManifestError -> Bool
< :: ManifestError -> ManifestError -> Bool
$c< :: ManifestError -> ManifestError -> Bool
compare :: ManifestError -> ManifestError -> Ordering
$ccompare :: ManifestError -> ManifestError -> Ordering
Ord, forall x. Rep ManifestError x -> ManifestError
forall x. ManifestError -> Rep ManifestError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ManifestError x -> ManifestError
$cfrom :: forall x. ManifestError -> Rep ManifestError x
Generic)

instance NFData ManifestError

showManifestError :: ManifestError -> Text
showManifestError :: ManifestError -> Text
showManifestError = \case
  BowerManifest BowerError
err -> BowerError -> Text
showBowerError BowerError
err
  PursManifest PursJsonError
err -> PursJsonError -> Text
showPursJsonError PursJsonError
err

verifyPackage :: GithubUser -> UploadedPackage -> VerifiedPackage
verifyPackage :: GithubUser -> UploadedPackage -> VerifiedPackage
verifyPackage GithubUser
verifiedUser Package{[(PackageName, Version)]
[Module]
Maybe UTCTime
(GithubUser, GithubRepo)
Version
Map ModuleName PackageName
Text
PackageMeta
NotYetKnown
pkgCompilerVersion :: Version
pkgUploader :: NotYetKnown
pkgGithub :: (GithubUser, GithubRepo)
pkgResolvedDependencies :: [(PackageName, Version)]
pkgModuleMap :: Map ModuleName PackageName
pkgModules :: [Module]
pkgTagTime :: Maybe UTCTime
pkgVersionTag :: Text
pkgVersion :: Version
pkgMeta :: PackageMeta
pkgCompilerVersion :: forall a. Package a -> Version
pkgUploader :: forall a. Package a -> a
pkgGithub :: forall a. Package a -> (GithubUser, GithubRepo)
pkgResolvedDependencies :: forall a. Package a -> [(PackageName, Version)]
pkgModuleMap :: forall a. Package a -> Map ModuleName PackageName
pkgModules :: forall a. Package a -> [Module]
pkgTagTime :: forall a. Package a -> Maybe UTCTime
pkgVersionTag :: forall a. Package a -> Text
pkgVersion :: forall a. Package a -> Version
pkgMeta :: forall a. Package a -> PackageMeta
..} =
  forall a.
PackageMeta
-> Version
-> Text
-> Maybe UTCTime
-> [Module]
-> Map ModuleName PackageName
-> [(PackageName, Version)]
-> (GithubUser, GithubRepo)
-> a
-> Version
-> Package a
Package PackageMeta
pkgMeta
          Version
pkgVersion
          Text
pkgVersionTag
          Maybe UTCTime
pkgTagTime
          [Module]
pkgModules
          Map ModuleName PackageName
pkgModuleMap
          [(PackageName, Version)]
pkgResolvedDependencies
          (GithubUser, GithubRepo)
pkgGithub
          GithubUser
verifiedUser
          Version
pkgCompilerVersion

packageName :: Package a -> PackageName
packageName :: forall a. Package a -> PackageName
packageName = PackageMeta -> PackageName
bowerName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Package a -> PackageMeta
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 :: String
jsonTimeFormat = String
"%Y-%m-%dT%H:%M:%S%z"

-- |
-- Convenience function for formatting a time in the format expected by this
-- module.
--
formatTime :: UTCTime -> String
formatTime :: UTCTime -> String
formatTime =
  forall t. FormatTime t => TimeLocale -> String -> t -> String
TimeFormat.formatTime TimeLocale
TimeFormat.defaultTimeLocale String
jsonTimeFormat

-- |
-- Convenience function for parsing a time in the format expected by this
-- module.
--
parseTime :: String -> Maybe UTCTime
parseTime :: String -> Maybe UTCTime
parseTime =
  forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
TimeFormat.parseTimeM Bool
False TimeLocale
TimeFormat.defaultTimeLocale String
jsonTimeFormat

data Module = Module
  { Module -> ModuleName
modName         :: P.ModuleName
  , Module -> Maybe Text
modComments     :: Maybe Text
  , Module -> [Declaration]
modDeclarations :: [Declaration]
  -- Re-exported values from other modules
  , Module -> [(InPackage ModuleName, [Declaration])]
modReExports    :: [(InPackage P.ModuleName, [Declaration])]
  }
  deriving (Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Module] -> ShowS
$cshowList :: [Module] -> ShowS
show :: Module -> String
$cshow :: Module -> String
showsPrec :: Int -> Module -> ShowS
$cshowsPrec :: Int -> Module -> ShowS
Show, Module -> Module -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c== :: Module -> Module -> Bool
Eq, Eq Module
Module -> Module -> Bool
Module -> Module -> Ordering
Module -> Module -> Module
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Module -> Module -> Module
$cmin :: Module -> Module -> Module
max :: Module -> Module -> Module
$cmax :: Module -> Module -> Module
>= :: Module -> Module -> Bool
$c>= :: Module -> Module -> Bool
> :: Module -> Module -> Bool
$c> :: Module -> Module -> Bool
<= :: Module -> Module -> Bool
$c<= :: Module -> Module -> Bool
< :: Module -> Module -> Bool
$c< :: Module -> Module -> Bool
compare :: Module -> Module -> Ordering
$ccompare :: Module -> Module -> Ordering
Ord, forall x. Rep Module x -> Module
forall x. Module -> Rep Module x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Module x -> Module
$cfrom :: forall x. Module -> Rep Module x
Generic)

instance NFData Module

data Declaration = Declaration
  { Declaration -> Text
declTitle      :: Text
  , Declaration -> Maybe Text
declComments   :: Maybe Text
  , Declaration -> Maybe SourceSpan
declSourceSpan :: Maybe P.SourceSpan
  , Declaration -> [ChildDeclaration]
declChildren   :: [ChildDeclaration]
  , Declaration -> DeclarationInfo
declInfo       :: DeclarationInfo
  , Declaration -> Maybe KindInfo
declKind       :: Maybe KindInfo
  }
  deriving (Int -> Declaration -> ShowS
[Declaration] -> ShowS
Declaration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Declaration] -> ShowS
$cshowList :: [Declaration] -> ShowS
show :: Declaration -> String
$cshow :: Declaration -> String
showsPrec :: Int -> Declaration -> ShowS
$cshowsPrec :: Int -> Declaration -> ShowS
Show, Declaration -> Declaration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Declaration -> Declaration -> Bool
$c/= :: Declaration -> Declaration -> Bool
== :: Declaration -> Declaration -> Bool
$c== :: Declaration -> Declaration -> Bool
Eq, Eq Declaration
Declaration -> Declaration -> Bool
Declaration -> Declaration -> Ordering
Declaration -> Declaration -> Declaration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Declaration -> Declaration -> Declaration
$cmin :: Declaration -> Declaration -> Declaration
max :: Declaration -> Declaration -> Declaration
$cmax :: Declaration -> Declaration -> Declaration
>= :: Declaration -> Declaration -> Bool
$c>= :: Declaration -> Declaration -> Bool
> :: Declaration -> Declaration -> Bool
$c> :: Declaration -> Declaration -> Bool
<= :: Declaration -> Declaration -> Bool
$c<= :: Declaration -> Declaration -> Bool
< :: Declaration -> Declaration -> Bool
$c< :: Declaration -> Declaration -> Bool
compare :: Declaration -> Declaration -> Ordering
$ccompare :: Declaration -> Declaration -> Ordering
Ord, forall x. Rep Declaration x -> Declaration
forall x. Declaration -> Rep Declaration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Declaration x -> Declaration
$cfrom :: forall x. Declaration -> Rep Declaration x
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 (Int -> DeclarationInfo -> ShowS
[DeclarationInfo] -> ShowS
DeclarationInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeclarationInfo] -> ShowS
$cshowList :: [DeclarationInfo] -> ShowS
show :: DeclarationInfo -> String
$cshow :: DeclarationInfo -> String
showsPrec :: Int -> DeclarationInfo -> ShowS
$cshowsPrec :: Int -> DeclarationInfo -> ShowS
Show, DeclarationInfo -> DeclarationInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeclarationInfo -> DeclarationInfo -> Bool
$c/= :: DeclarationInfo -> DeclarationInfo -> Bool
== :: DeclarationInfo -> DeclarationInfo -> Bool
$c== :: DeclarationInfo -> DeclarationInfo -> Bool
Eq, Eq DeclarationInfo
DeclarationInfo -> DeclarationInfo -> Bool
DeclarationInfo -> DeclarationInfo -> Ordering
DeclarationInfo -> DeclarationInfo -> DeclarationInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DeclarationInfo -> DeclarationInfo -> DeclarationInfo
$cmin :: DeclarationInfo -> DeclarationInfo -> DeclarationInfo
max :: DeclarationInfo -> DeclarationInfo -> DeclarationInfo
$cmax :: DeclarationInfo -> DeclarationInfo -> DeclarationInfo
>= :: DeclarationInfo -> DeclarationInfo -> Bool
$c>= :: DeclarationInfo -> DeclarationInfo -> Bool
> :: DeclarationInfo -> DeclarationInfo -> Bool
$c> :: DeclarationInfo -> DeclarationInfo -> Bool
<= :: DeclarationInfo -> DeclarationInfo -> Bool
$c<= :: DeclarationInfo -> DeclarationInfo -> Bool
< :: DeclarationInfo -> DeclarationInfo -> Bool
$c< :: DeclarationInfo -> DeclarationInfo -> Bool
compare :: DeclarationInfo -> DeclarationInfo -> Ordering
$ccompare :: DeclarationInfo -> DeclarationInfo -> Ordering
Ord, forall x. Rep DeclarationInfo x -> DeclarationInfo
forall x. DeclarationInfo -> Rep DeclarationInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeclarationInfo x -> DeclarationInfo
$cfrom :: forall x. DeclarationInfo -> Rep DeclarationInfo x
Generic)

instance NFData DeclarationInfo

-- |
-- Wraps enough information to properly render the kind signature
-- of a data/newtype/type/class declaration.
data KindInfo = KindInfo
  { KindInfo -> KindSignatureFor
kiKeyword :: P.KindSignatureFor
  , KindInfo -> Type'
kiKind :: Type'
  }
  deriving (Int -> KindInfo -> ShowS
[KindInfo] -> ShowS
KindInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KindInfo] -> ShowS
$cshowList :: [KindInfo] -> ShowS
show :: KindInfo -> String
$cshow :: KindInfo -> String
showsPrec :: Int -> KindInfo -> ShowS
$cshowsPrec :: Int -> KindInfo -> ShowS
Show, KindInfo -> KindInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KindInfo -> KindInfo -> Bool
$c/= :: KindInfo -> KindInfo -> Bool
== :: KindInfo -> KindInfo -> Bool
$c== :: KindInfo -> KindInfo -> Bool
Eq, Eq KindInfo
KindInfo -> KindInfo -> Bool
KindInfo -> KindInfo -> Ordering
KindInfo -> KindInfo -> KindInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KindInfo -> KindInfo -> KindInfo
$cmin :: KindInfo -> KindInfo -> KindInfo
max :: KindInfo -> KindInfo -> KindInfo
$cmax :: KindInfo -> KindInfo -> KindInfo
>= :: KindInfo -> KindInfo -> Bool
$c>= :: KindInfo -> KindInfo -> Bool
> :: KindInfo -> KindInfo -> Bool
$c> :: KindInfo -> KindInfo -> Bool
<= :: KindInfo -> KindInfo -> Bool
$c<= :: KindInfo -> KindInfo -> Bool
< :: KindInfo -> KindInfo -> Bool
$c< :: KindInfo -> KindInfo -> Bool
compare :: KindInfo -> KindInfo -> Ordering
$ccompare :: KindInfo -> KindInfo -> Ordering
Ord, forall x. Rep KindInfo x -> KindInfo
forall x. KindInfo -> Rep KindInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KindInfo x -> KindInfo
$cfrom :: forall x. KindInfo -> Rep KindInfo x
Generic)

instance NFData KindInfo

convertFundepsToStrings :: [(Text, Maybe Type')] -> [P.FunctionalDependency] -> [([Text], [Text])]
convertFundepsToStrings :: [(Text, Maybe Type')]
-> [FunctionalDependency] -> [([Text], [Text])]
convertFundepsToStrings [(Text, Maybe Type')]
args [FunctionalDependency]
fundeps =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(P.FunctionalDependency [Int]
from [Int]
to) -> [Int] -> [Int] -> ([Text], [Text])
toArgs [Int]
from [Int]
to) [FunctionalDependency]
fundeps
  where
  argsVec :: Vector Text
argsVec = forall a. [a] -> Vector a
V.fromList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall a b. (a, b) -> a
fst [(Text, Maybe Type')]
args)
  getArg :: Int -> Text
getArg Int
i =
    forall a. a -> Maybe a -> a
fromMaybe
      (forall a. HasCallStack => String -> a
P.internalError forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        [ String
"convertDeclaration: Functional dependency index"
        , forall a b. (Show a, StringConv String b) => a -> b
show Int
i
        , String
"is bigger than arguments list"
        , forall a b. (Show a, StringConv String b) => a -> b
show (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall a b. (a, b) -> a
fst [(Text, Maybe Type')]
args)
        , String
"Functional dependencies are"
        , forall a b. (Show a, StringConv String b) => a -> b
show [FunctionalDependency]
fundeps
        ]
      ) forall a b. (a -> b) -> a -> b
$ Vector Text
argsVec forall a. Vector a -> Int -> Maybe a
V.!? Int
i
  toArgs :: [Int] -> [Int] -> ([Text], [Text])
toArgs [Int]
from [Int]
to = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Int -> Text
getArg [Int]
from, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Int -> Text
getArg [Int]
to)

declInfoToString :: DeclarationInfo -> Text
declInfoToString :: DeclarationInfo -> Text
declInfoToString (ValueDeclaration Type'
_) = Text
"value"
declInfoToString (DataDeclaration DataDeclType
_ [(Text, Maybe Type')]
_ [Role]
_) = Text
"data"
declInfoToString (ExternDataDeclaration Type'
_ [Role]
_) = Text
"externData"
declInfoToString (TypeSynonymDeclaration [(Text, Maybe Type')]
_ Type'
_) = Text
"typeSynonym"
declInfoToString (TypeClassDeclaration [(Text, Maybe Type')]
_ [Constraint']
_ [([Text], [Text])]
_) = Text
"typeClass"
declInfoToString (AliasDeclaration Fixity
_ FixityAlias
_) = Text
"alias"

declInfoNamespace :: DeclarationInfo -> Namespace
declInfoNamespace :: DeclarationInfo -> Namespace
declInfoNamespace = \case
  ValueDeclaration{} ->
    Namespace
ValueLevel
  DataDeclaration{} ->
    Namespace
TypeLevel
  ExternDataDeclaration{} ->
    Namespace
TypeLevel
  TypeSynonymDeclaration{} ->
    Namespace
TypeLevel
  TypeClassDeclaration{} ->
    Namespace
TypeLevel
  AliasDeclaration Fixity
_ FixityAlias
alias ->
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Namespace
TypeLevel) (forall a b. a -> b -> a
const Namespace
ValueLevel) (forall a. Qualified a -> a
P.disqualify FixityAlias
alias)

isTypeClass :: Declaration -> Bool
isTypeClass :: Declaration -> Bool
isTypeClass Declaration{[ChildDeclaration]
Maybe Text
Maybe SourceSpan
Maybe KindInfo
Text
DeclarationInfo
declKind :: Maybe KindInfo
declInfo :: DeclarationInfo
declChildren :: [ChildDeclaration]
declSourceSpan :: Maybe SourceSpan
declComments :: Maybe Text
declTitle :: Text
declKind :: Declaration -> Maybe KindInfo
declInfo :: Declaration -> DeclarationInfo
declChildren :: Declaration -> [ChildDeclaration]
declSourceSpan :: Declaration -> Maybe SourceSpan
declComments :: Declaration -> Maybe Text
declTitle :: Declaration -> Text
..} =
  case DeclarationInfo
declInfo of
    TypeClassDeclaration{} -> Bool
True
    DeclarationInfo
_ -> Bool
False

isValue :: Declaration -> Bool
isValue :: Declaration -> Bool
isValue Declaration{[ChildDeclaration]
Maybe Text
Maybe SourceSpan
Maybe KindInfo
Text
DeclarationInfo
declKind :: Maybe KindInfo
declInfo :: DeclarationInfo
declChildren :: [ChildDeclaration]
declSourceSpan :: Maybe SourceSpan
declComments :: Maybe Text
declTitle :: Text
declKind :: Declaration -> Maybe KindInfo
declInfo :: Declaration -> DeclarationInfo
declChildren :: Declaration -> [ChildDeclaration]
declSourceSpan :: Declaration -> Maybe SourceSpan
declComments :: Declaration -> Maybe Text
declTitle :: Declaration -> Text
..} =
  case DeclarationInfo
declInfo of
    ValueDeclaration{} -> Bool
True
    DeclarationInfo
_ -> Bool
False

isType :: Declaration ->  Bool
isType :: Declaration -> Bool
isType Declaration{[ChildDeclaration]
Maybe Text
Maybe SourceSpan
Maybe KindInfo
Text
DeclarationInfo
declKind :: Maybe KindInfo
declInfo :: DeclarationInfo
declChildren :: [ChildDeclaration]
declSourceSpan :: Maybe SourceSpan
declComments :: Maybe Text
declTitle :: Text
declKind :: Declaration -> Maybe KindInfo
declInfo :: Declaration -> DeclarationInfo
declChildren :: Declaration -> [ChildDeclaration]
declSourceSpan :: Declaration -> Maybe SourceSpan
declComments :: Declaration -> Maybe Text
declTitle :: Declaration -> Text
..} =
  case DeclarationInfo
declInfo of
    TypeSynonymDeclaration{} -> Bool
True
    DataDeclaration{} -> Bool
True
    ExternDataDeclaration{} -> Bool
True
    DeclarationInfo
_ -> Bool
False

isValueAlias :: Declaration -> Bool
isValueAlias :: Declaration -> Bool
isValueAlias Declaration{[ChildDeclaration]
Maybe Text
Maybe SourceSpan
Maybe KindInfo
Text
DeclarationInfo
declKind :: Maybe KindInfo
declInfo :: DeclarationInfo
declChildren :: [ChildDeclaration]
declSourceSpan :: Maybe SourceSpan
declComments :: Maybe Text
declTitle :: Text
declKind :: Declaration -> Maybe KindInfo
declInfo :: Declaration -> DeclarationInfo
declChildren :: Declaration -> [ChildDeclaration]
declSourceSpan :: Declaration -> Maybe SourceSpan
declComments :: Declaration -> Maybe Text
declTitle :: Declaration -> Text
..} =
  case DeclarationInfo
declInfo of
    AliasDeclaration Fixity
_ (P.Qualified QualifiedBy
_ Either
  (ProperName 'TypeName) (Either Ident (ProperName 'ConstructorName))
d) -> forall a b. Either a b -> Bool
isRight Either
  (ProperName 'TypeName) (Either Ident (ProperName 'ConstructorName))
d
    DeclarationInfo
_ -> Bool
False

isTypeAlias :: Declaration -> Bool
isTypeAlias :: Declaration -> Bool
isTypeAlias Declaration{[ChildDeclaration]
Maybe Text
Maybe SourceSpan
Maybe KindInfo
Text
DeclarationInfo
declKind :: Maybe KindInfo
declInfo :: DeclarationInfo
declChildren :: [ChildDeclaration]
declSourceSpan :: Maybe SourceSpan
declComments :: Maybe Text
declTitle :: Text
declKind :: Declaration -> Maybe KindInfo
declInfo :: Declaration -> DeclarationInfo
declChildren :: Declaration -> [ChildDeclaration]
declSourceSpan :: Declaration -> Maybe SourceSpan
declComments :: Declaration -> Maybe Text
declTitle :: Declaration -> Text
..} =
  case DeclarationInfo
declInfo of
    AliasDeclaration Fixity
_ (P.Qualified QualifiedBy
_ Either
  (ProperName 'TypeName) (Either Ident (ProperName 'ConstructorName))
d) -> forall a b. Either a b -> Bool
isLeft Either
  (ProperName 'TypeName) (Either Ident (ProperName 'ConstructorName))
d
    DeclarationInfo
_ -> Bool
False

-- | Discard any children which do not satisfy the given predicate.
filterChildren :: (ChildDeclaration -> Bool) -> Declaration -> Declaration
filterChildren :: (ChildDeclaration -> Bool) -> Declaration -> Declaration
filterChildren ChildDeclaration -> Bool
p Declaration
decl =
  Declaration
decl { declChildren :: [ChildDeclaration]
declChildren = forall a. (a -> Bool) -> [a] -> [a]
filter ChildDeclaration -> Bool
p (Declaration -> [ChildDeclaration]
declChildren Declaration
decl) }

data ChildDeclaration = ChildDeclaration
  { ChildDeclaration -> Text
cdeclTitle      :: Text
  , ChildDeclaration -> Maybe Text
cdeclComments   :: Maybe Text
  , ChildDeclaration -> Maybe SourceSpan
cdeclSourceSpan :: Maybe P.SourceSpan
  , ChildDeclaration -> ChildDeclarationInfo
cdeclInfo       :: ChildDeclarationInfo
  }
  deriving (Int -> ChildDeclaration -> ShowS
[ChildDeclaration] -> ShowS
ChildDeclaration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChildDeclaration] -> ShowS
$cshowList :: [ChildDeclaration] -> ShowS
show :: ChildDeclaration -> String
$cshow :: ChildDeclaration -> String
showsPrec :: Int -> ChildDeclaration -> ShowS
$cshowsPrec :: Int -> ChildDeclaration -> ShowS
Show, ChildDeclaration -> ChildDeclaration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChildDeclaration -> ChildDeclaration -> Bool
$c/= :: ChildDeclaration -> ChildDeclaration -> Bool
== :: ChildDeclaration -> ChildDeclaration -> Bool
$c== :: ChildDeclaration -> ChildDeclaration -> Bool
Eq, Eq ChildDeclaration
ChildDeclaration -> ChildDeclaration -> Bool
ChildDeclaration -> ChildDeclaration -> Ordering
ChildDeclaration -> ChildDeclaration -> ChildDeclaration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChildDeclaration -> ChildDeclaration -> ChildDeclaration
$cmin :: ChildDeclaration -> ChildDeclaration -> ChildDeclaration
max :: ChildDeclaration -> ChildDeclaration -> ChildDeclaration
$cmax :: ChildDeclaration -> ChildDeclaration -> ChildDeclaration
>= :: ChildDeclaration -> ChildDeclaration -> Bool
$c>= :: ChildDeclaration -> ChildDeclaration -> Bool
> :: ChildDeclaration -> ChildDeclaration -> Bool
$c> :: ChildDeclaration -> ChildDeclaration -> Bool
<= :: ChildDeclaration -> ChildDeclaration -> Bool
$c<= :: ChildDeclaration -> ChildDeclaration -> Bool
< :: ChildDeclaration -> ChildDeclaration -> Bool
$c< :: ChildDeclaration -> ChildDeclaration -> Bool
compare :: ChildDeclaration -> ChildDeclaration -> Ordering
$ccompare :: ChildDeclaration -> ChildDeclaration -> Ordering
Ord, forall x. Rep ChildDeclaration x -> ChildDeclaration
forall x. ChildDeclaration -> Rep ChildDeclaration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChildDeclaration x -> ChildDeclaration
$cfrom :: forall x. ChildDeclaration -> Rep ChildDeclaration x
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 (Int -> ChildDeclarationInfo -> ShowS
[ChildDeclarationInfo] -> ShowS
ChildDeclarationInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChildDeclarationInfo] -> ShowS
$cshowList :: [ChildDeclarationInfo] -> ShowS
show :: ChildDeclarationInfo -> String
$cshow :: ChildDeclarationInfo -> String
showsPrec :: Int -> ChildDeclarationInfo -> ShowS
$cshowsPrec :: Int -> ChildDeclarationInfo -> ShowS
Show, ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
$c/= :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
== :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
$c== :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
Eq, Eq ChildDeclarationInfo
ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
ChildDeclarationInfo -> ChildDeclarationInfo -> Ordering
ChildDeclarationInfo
-> ChildDeclarationInfo -> ChildDeclarationInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChildDeclarationInfo
-> ChildDeclarationInfo -> ChildDeclarationInfo
$cmin :: ChildDeclarationInfo
-> ChildDeclarationInfo -> ChildDeclarationInfo
max :: ChildDeclarationInfo
-> ChildDeclarationInfo -> ChildDeclarationInfo
$cmax :: ChildDeclarationInfo
-> ChildDeclarationInfo -> ChildDeclarationInfo
>= :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
$c>= :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
> :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
$c> :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
<= :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
$c<= :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
< :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
$c< :: ChildDeclarationInfo -> ChildDeclarationInfo -> Bool
compare :: ChildDeclarationInfo -> ChildDeclarationInfo -> Ordering
$ccompare :: ChildDeclarationInfo -> ChildDeclarationInfo -> Ordering
Ord, forall x. Rep ChildDeclarationInfo x -> ChildDeclarationInfo
forall x. ChildDeclarationInfo -> Rep ChildDeclarationInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChildDeclarationInfo x -> ChildDeclarationInfo
$cfrom :: forall x. ChildDeclarationInfo -> Rep ChildDeclarationInfo x
Generic)

instance NFData ChildDeclarationInfo

childDeclInfoToString :: ChildDeclarationInfo -> Text
childDeclInfoToString :: ChildDeclarationInfo -> Text
childDeclInfoToString (ChildInstance [Constraint']
_ Type'
_)      = Text
"instance"
childDeclInfoToString (ChildDataConstructor [Type']
_) = Text
"dataConstructor"
childDeclInfoToString (ChildTypeClassMember Type'
_) = Text
"typeClassMember"

childDeclInfoNamespace :: ChildDeclarationInfo -> Namespace
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{} ->
      Namespace
ValueLevel
    ChildDataConstructor{} ->
      Namespace
ValueLevel
    ChildTypeClassMember{} ->
      Namespace
ValueLevel

isTypeClassMember :: ChildDeclaration -> Bool
isTypeClassMember :: ChildDeclaration -> Bool
isTypeClassMember ChildDeclaration{Maybe Text
Maybe SourceSpan
Text
ChildDeclarationInfo
cdeclInfo :: ChildDeclarationInfo
cdeclSourceSpan :: Maybe SourceSpan
cdeclComments :: Maybe Text
cdeclTitle :: Text
cdeclInfo :: ChildDeclaration -> ChildDeclarationInfo
cdeclSourceSpan :: ChildDeclaration -> Maybe SourceSpan
cdeclComments :: ChildDeclaration -> Maybe Text
cdeclTitle :: ChildDeclaration -> Text
..} =
  case ChildDeclarationInfo
cdeclInfo of
    ChildTypeClassMember{} -> Bool
True
    ChildDeclarationInfo
_ -> Bool
False

isDataConstructor :: ChildDeclaration -> Bool
isDataConstructor :: ChildDeclaration -> Bool
isDataConstructor ChildDeclaration{Maybe Text
Maybe SourceSpan
Text
ChildDeclarationInfo
cdeclInfo :: ChildDeclarationInfo
cdeclSourceSpan :: Maybe SourceSpan
cdeclComments :: Maybe Text
cdeclTitle :: Text
cdeclInfo :: ChildDeclaration -> ChildDeclarationInfo
cdeclSourceSpan :: ChildDeclaration -> Maybe SourceSpan
cdeclComments :: ChildDeclaration -> Maybe Text
cdeclTitle :: ChildDeclaration -> Text
..} =
  case ChildDeclarationInfo
cdeclInfo of
    ChildDataConstructor{} -> Bool
True
    ChildDeclarationInfo
_ -> Bool
False

newtype GithubUser
  = GithubUser { GithubUser -> Text
runGithubUser :: Text }
  deriving (Int -> GithubUser -> ShowS
[GithubUser] -> ShowS
GithubUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GithubUser] -> ShowS
$cshowList :: [GithubUser] -> ShowS
show :: GithubUser -> String
$cshow :: GithubUser -> String
showsPrec :: Int -> GithubUser -> ShowS
$cshowsPrec :: Int -> GithubUser -> ShowS
Show, GithubUser -> GithubUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GithubUser -> GithubUser -> Bool
$c/= :: GithubUser -> GithubUser -> Bool
== :: GithubUser -> GithubUser -> Bool
$c== :: GithubUser -> GithubUser -> Bool
Eq, Eq GithubUser
GithubUser -> GithubUser -> Bool
GithubUser -> GithubUser -> Ordering
GithubUser -> GithubUser -> GithubUser
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GithubUser -> GithubUser -> GithubUser
$cmin :: GithubUser -> GithubUser -> GithubUser
max :: GithubUser -> GithubUser -> GithubUser
$cmax :: GithubUser -> GithubUser -> GithubUser
>= :: GithubUser -> GithubUser -> Bool
$c>= :: GithubUser -> GithubUser -> Bool
> :: GithubUser -> GithubUser -> Bool
$c> :: GithubUser -> GithubUser -> Bool
<= :: GithubUser -> GithubUser -> Bool
$c<= :: GithubUser -> GithubUser -> Bool
< :: GithubUser -> GithubUser -> Bool
$c< :: GithubUser -> GithubUser -> Bool
compare :: GithubUser -> GithubUser -> Ordering
$ccompare :: GithubUser -> GithubUser -> Ordering
Ord, forall x. Rep GithubUser x -> GithubUser
forall x. GithubUser -> Rep GithubUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GithubUser x -> GithubUser
$cfrom :: forall x. GithubUser -> Rep GithubUser x
Generic)

instance NFData GithubUser

newtype GithubRepo
  = GithubRepo { GithubRepo -> Text
runGithubRepo :: Text }
  deriving (Int -> GithubRepo -> ShowS
[GithubRepo] -> ShowS
GithubRepo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GithubRepo] -> ShowS
$cshowList :: [GithubRepo] -> ShowS
show :: GithubRepo -> String
$cshow :: GithubRepo -> String
showsPrec :: Int -> GithubRepo -> ShowS
$cshowsPrec :: Int -> GithubRepo -> ShowS
Show, GithubRepo -> GithubRepo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GithubRepo -> GithubRepo -> Bool
$c/= :: GithubRepo -> GithubRepo -> Bool
== :: GithubRepo -> GithubRepo -> Bool
$c== :: GithubRepo -> GithubRepo -> Bool
Eq, Eq GithubRepo
GithubRepo -> GithubRepo -> Bool
GithubRepo -> GithubRepo -> Ordering
GithubRepo -> GithubRepo -> GithubRepo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GithubRepo -> GithubRepo -> GithubRepo
$cmin :: GithubRepo -> GithubRepo -> GithubRepo
max :: GithubRepo -> GithubRepo -> GithubRepo
$cmax :: GithubRepo -> GithubRepo -> GithubRepo
>= :: GithubRepo -> GithubRepo -> Bool
$c>= :: GithubRepo -> GithubRepo -> Bool
> :: GithubRepo -> GithubRepo -> Bool
$c> :: GithubRepo -> GithubRepo -> Bool
<= :: GithubRepo -> GithubRepo -> Bool
$c<= :: GithubRepo -> GithubRepo -> Bool
< :: GithubRepo -> GithubRepo -> Bool
$c< :: GithubRepo -> GithubRepo -> Bool
compare :: GithubRepo -> GithubRepo -> Ordering
$ccompare :: GithubRepo -> GithubRepo -> Ordering
Ord, forall x. Rep GithubRepo x -> GithubRepo
forall x. GithubRepo -> Rep GithubRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GithubRepo x -> GithubRepo
$cfrom :: forall x. GithubRepo -> Rep GithubRepo x
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 (Int -> PackageError -> ShowS
[PackageError] -> ShowS
PackageError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageError] -> ShowS
$cshowList :: [PackageError] -> ShowS
show :: PackageError -> String
$cshow :: PackageError -> String
showsPrec :: Int -> PackageError -> ShowS
$cshowsPrec :: Int -> PackageError -> ShowS
Show, PackageError -> PackageError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageError -> PackageError -> Bool
$c/= :: PackageError -> PackageError -> Bool
== :: PackageError -> PackageError -> Bool
$c== :: PackageError -> PackageError -> Bool
Eq, Eq PackageError
PackageError -> PackageError -> Bool
PackageError -> PackageError -> Ordering
PackageError -> PackageError -> PackageError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageError -> PackageError -> PackageError
$cmin :: PackageError -> PackageError -> PackageError
max :: PackageError -> PackageError -> PackageError
$cmax :: PackageError -> PackageError -> PackageError
>= :: PackageError -> PackageError -> Bool
$c>= :: PackageError -> PackageError -> Bool
> :: PackageError -> PackageError -> Bool
$c> :: PackageError -> PackageError -> Bool
<= :: PackageError -> PackageError -> Bool
$c<= :: PackageError -> PackageError -> Bool
< :: PackageError -> PackageError -> Bool
$c< :: PackageError -> PackageError -> Bool
compare :: PackageError -> PackageError -> Ordering
$ccompare :: PackageError -> PackageError -> Ordering
Ord, forall x. Rep PackageError x -> PackageError
forall x. PackageError -> Rep PackageError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageError x -> PackageError
$cfrom :: forall x. PackageError -> Rep PackageError x
Generic)

instance NFData PackageError

data InPackage a
  = Local a
  | FromDep PackageName a
  deriving (Int -> InPackage a -> ShowS
forall a. Show a => Int -> InPackage a -> ShowS
forall a. Show a => [InPackage a] -> ShowS
forall a. Show a => InPackage a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InPackage a] -> ShowS
$cshowList :: forall a. Show a => [InPackage a] -> ShowS
show :: InPackage a -> String
$cshow :: forall a. Show a => InPackage a -> String
showsPrec :: Int -> InPackage a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> InPackage a -> ShowS
Show, InPackage a -> InPackage a -> Bool
forall a. Eq a => InPackage a -> InPackage a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InPackage a -> InPackage a -> Bool
$c/= :: forall a. Eq a => InPackage a -> InPackage a -> Bool
== :: InPackage a -> InPackage a -> Bool
$c== :: forall a. Eq a => InPackage a -> InPackage a -> Bool
Eq, InPackage a -> InPackage a -> Bool
InPackage a -> InPackage a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (InPackage a)
forall a. Ord a => InPackage a -> InPackage a -> Bool
forall a. Ord a => InPackage a -> InPackage a -> Ordering
forall a. Ord a => InPackage a -> InPackage a -> InPackage a
min :: InPackage a -> InPackage a -> InPackage a
$cmin :: forall a. Ord a => InPackage a -> InPackage a -> InPackage a
max :: InPackage a -> InPackage a -> InPackage a
$cmax :: forall a. Ord a => InPackage a -> InPackage a -> InPackage a
>= :: InPackage a -> InPackage a -> Bool
$c>= :: forall a. Ord a => InPackage a -> InPackage a -> Bool
> :: InPackage a -> InPackage a -> Bool
$c> :: forall a. Ord a => InPackage a -> InPackage a -> Bool
<= :: InPackage a -> InPackage a -> Bool
$c<= :: forall a. Ord a => InPackage a -> InPackage a -> Bool
< :: InPackage a -> InPackage a -> Bool
$c< :: forall a. Ord a => InPackage a -> InPackage a -> Bool
compare :: InPackage a -> InPackage a -> Ordering
$ccompare :: forall a. Ord a => InPackage a -> InPackage a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (InPackage a) x -> InPackage a
forall a x. InPackage a -> Rep (InPackage a) x
$cto :: forall a x. Rep (InPackage a) x -> InPackage a
$cfrom :: forall a x. InPackage a -> Rep (InPackage a) x
Generic)

instance NFData a => NFData (InPackage a)

instance Functor InPackage where
  fmap :: forall a b. (a -> b) -> InPackage a -> InPackage b
fmap a -> b
f (Local a
x) = forall a. a -> InPackage a
Local (a -> b
f a
x)
  fmap a -> b
f (FromDep PackageName
pkgName a
x) = forall a. PackageName -> a -> InPackage a
FromDep PackageName
pkgName (a -> b
f a
x)

ignorePackage :: InPackage a -> a
ignorePackage :: forall a. InPackage a -> a
ignorePackage (Local a
x) = a
x
ignorePackage (FromDep PackageName
_ a
x) = a
x

----------------------------------------------------
-- Types for links between declarations

data LinksContext = LinksContext
  { LinksContext -> (GithubUser, GithubRepo)
ctxGithub               :: (GithubUser, GithubRepo)
  , LinksContext -> Map ModuleName PackageName
ctxModuleMap            :: Map P.ModuleName PackageName
  , LinksContext -> [(PackageName, Version)]
ctxResolvedDependencies :: [(PackageName, Version)]
  , LinksContext -> PackageName
ctxPackageName          :: PackageName
  , LinksContext -> Version
ctxVersion              :: Version
  , LinksContext -> Text
ctxVersionTag           :: Text
  }
  deriving (Int -> LinksContext -> ShowS
[LinksContext] -> ShowS
LinksContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinksContext] -> ShowS
$cshowList :: [LinksContext] -> ShowS
show :: LinksContext -> String
$cshow :: LinksContext -> String
showsPrec :: Int -> LinksContext -> ShowS
$cshowsPrec :: Int -> LinksContext -> ShowS
Show, LinksContext -> LinksContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinksContext -> LinksContext -> Bool
$c/= :: LinksContext -> LinksContext -> Bool
== :: LinksContext -> LinksContext -> Bool
$c== :: LinksContext -> LinksContext -> Bool
Eq, Eq LinksContext
LinksContext -> LinksContext -> Bool
LinksContext -> LinksContext -> Ordering
LinksContext -> LinksContext -> LinksContext
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LinksContext -> LinksContext -> LinksContext
$cmin :: LinksContext -> LinksContext -> LinksContext
max :: LinksContext -> LinksContext -> LinksContext
$cmax :: LinksContext -> LinksContext -> LinksContext
>= :: LinksContext -> LinksContext -> Bool
$c>= :: LinksContext -> LinksContext -> Bool
> :: LinksContext -> LinksContext -> Bool
$c> :: LinksContext -> LinksContext -> Bool
<= :: LinksContext -> LinksContext -> Bool
$c<= :: LinksContext -> LinksContext -> Bool
< :: LinksContext -> LinksContext -> Bool
$c< :: LinksContext -> LinksContext -> Bool
compare :: LinksContext -> LinksContext -> Ordering
$ccompare :: LinksContext -> LinksContext -> Ordering
Ord, forall x. Rep LinksContext x -> LinksContext
forall x. LinksContext -> Rep LinksContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LinksContext x -> LinksContext
$cfrom :: forall x. LinksContext -> Rep LinksContext x
Generic)

instance NFData LinksContext

data DocLink = DocLink
  { DocLink -> LinkLocation
linkLocation  :: LinkLocation
  , DocLink -> Text
linkTitle     :: Text
  , DocLink -> Namespace
linkNamespace :: Namespace
  }
  deriving (Int -> DocLink -> ShowS
[DocLink] -> ShowS
DocLink -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocLink] -> ShowS
$cshowList :: [DocLink] -> ShowS
show :: DocLink -> String
$cshow :: DocLink -> String
showsPrec :: Int -> DocLink -> ShowS
$cshowsPrec :: Int -> DocLink -> ShowS
Show, DocLink -> DocLink -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocLink -> DocLink -> Bool
$c/= :: DocLink -> DocLink -> Bool
== :: DocLink -> DocLink -> Bool
$c== :: DocLink -> DocLink -> Bool
Eq, Eq DocLink
DocLink -> DocLink -> Bool
DocLink -> DocLink -> Ordering
DocLink -> DocLink -> DocLink
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DocLink -> DocLink -> DocLink
$cmin :: DocLink -> DocLink -> DocLink
max :: DocLink -> DocLink -> DocLink
$cmax :: DocLink -> DocLink -> DocLink
>= :: DocLink -> DocLink -> Bool
$c>= :: DocLink -> DocLink -> Bool
> :: DocLink -> DocLink -> Bool
$c> :: DocLink -> DocLink -> Bool
<= :: DocLink -> DocLink -> Bool
$c<= :: DocLink -> DocLink -> Bool
< :: DocLink -> DocLink -> Bool
$c< :: DocLink -> DocLink -> Bool
compare :: DocLink -> DocLink -> Ordering
$ccompare :: DocLink -> DocLink -> Ordering
Ord, forall x. Rep DocLink x -> DocLink
forall x. DocLink -> Rep DocLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DocLink x -> DocLink
$cfrom :: forall x. DocLink -> Rep DocLink x
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 (Int -> LinkLocation -> ShowS
[LinkLocation] -> ShowS
LinkLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkLocation] -> ShowS
$cshowList :: [LinkLocation] -> ShowS
show :: LinkLocation -> String
$cshow :: LinkLocation -> String
showsPrec :: Int -> LinkLocation -> ShowS
$cshowsPrec :: Int -> LinkLocation -> ShowS
Show, LinkLocation -> LinkLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkLocation -> LinkLocation -> Bool
$c/= :: LinkLocation -> LinkLocation -> Bool
== :: LinkLocation -> LinkLocation -> Bool
$c== :: LinkLocation -> LinkLocation -> Bool
Eq, Eq LinkLocation
LinkLocation -> LinkLocation -> Bool
LinkLocation -> LinkLocation -> Ordering
LinkLocation -> LinkLocation -> LinkLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LinkLocation -> LinkLocation -> LinkLocation
$cmin :: LinkLocation -> LinkLocation -> LinkLocation
max :: LinkLocation -> LinkLocation -> LinkLocation
$cmax :: LinkLocation -> LinkLocation -> LinkLocation
>= :: LinkLocation -> LinkLocation -> Bool
$c>= :: LinkLocation -> LinkLocation -> Bool
> :: LinkLocation -> LinkLocation -> Bool
$c> :: LinkLocation -> LinkLocation -> Bool
<= :: LinkLocation -> LinkLocation -> Bool
$c<= :: LinkLocation -> LinkLocation -> Bool
< :: LinkLocation -> LinkLocation -> Bool
$c< :: LinkLocation -> LinkLocation -> Bool
compare :: LinkLocation -> LinkLocation -> Ordering
$ccompare :: LinkLocation -> LinkLocation -> Ordering
Ord, forall x. Rep LinkLocation x -> LinkLocation
forall x. LinkLocation -> Rep LinkLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LinkLocation x -> LinkLocation
$cfrom :: forall x. LinkLocation -> Rep LinkLocation x
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
-> ModuleName
-> Namespace
-> Text
-> ContainingModule
-> Maybe DocLink
getLink LinksContext{[(PackageName, Version)]
(GithubUser, GithubRepo)
Version
Map ModuleName PackageName
Text
PackageName
ctxVersionTag :: Text
ctxVersion :: Version
ctxPackageName :: PackageName
ctxResolvedDependencies :: [(PackageName, Version)]
ctxModuleMap :: Map ModuleName PackageName
ctxGithub :: (GithubUser, GithubRepo)
ctxVersionTag :: LinksContext -> Text
ctxVersion :: LinksContext -> Version
ctxPackageName :: LinksContext -> PackageName
ctxResolvedDependencies :: LinksContext -> [(PackageName, Version)]
ctxModuleMap :: LinksContext -> Map ModuleName PackageName
ctxGithub :: LinksContext -> (GithubUser, GithubRepo)
..} ModuleName
curMn Namespace
namespace Text
target ContainingModule
containingMod = do
  LinkLocation
location <- Maybe LinkLocation
getLinkLocation
  forall (m :: * -> *) a. Monad m => a -> m a
return DocLink
    { linkLocation :: LinkLocation
linkLocation = LinkLocation
location
    , linkTitle :: Text
linkTitle = Text
target
    , linkNamespace :: Namespace
linkNamespace = Namespace
namespace
    }

  where
  getLinkLocation :: Maybe LinkLocation
getLinkLocation = Maybe LinkLocation
builtinLinkLocation forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe LinkLocation
normalLinkLocation

  normalLinkLocation :: Maybe LinkLocation
normalLinkLocation = do
    case ContainingModule
containingMod of
      ContainingModule
ThisModule ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ModuleName -> LinkLocation
LocalModule ModuleName
curMn
      OtherModule ModuleName
destMn ->
        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
destMn Map ModuleName PackageName
ctxModuleMap of
          Maybe PackageName
Nothing ->
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ModuleName -> LinkLocation
LocalModule ModuleName
destMn
          Just PackageName
pkgName -> do
            Version
pkgVersion <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PackageName
pkgName [(PackageName, Version)]
ctxResolvedDependencies
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> ModuleName -> LinkLocation
DepsModule PackageName
pkgName Version
pkgVersion ModuleName
destMn

  builtinLinkLocation :: Maybe LinkLocation
builtinLinkLocation =
    case ContainingModule
containingMod of
      OtherModule ModuleName
mn | ModuleName -> Bool
P.isBuiltinModuleName ModuleName
mn ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ModuleName -> LinkLocation
BuiltinModule ModuleName
mn
      ContainingModule
_ ->
        forall (f :: * -> *) a. Alternative f => f a
empty

getLinksContext :: Package a -> LinksContext
getLinksContext :: forall a. Package a -> LinksContext
getLinksContext Package{a
[(PackageName, Version)]
[Module]
Maybe UTCTime
(GithubUser, GithubRepo)
Version
Map ModuleName PackageName
Text
PackageMeta
pkgCompilerVersion :: Version
pkgUploader :: a
pkgGithub :: (GithubUser, GithubRepo)
pkgResolvedDependencies :: [(PackageName, Version)]
pkgModuleMap :: Map ModuleName PackageName
pkgModules :: [Module]
pkgTagTime :: Maybe UTCTime
pkgVersionTag :: Text
pkgVersion :: Version
pkgMeta :: PackageMeta
pkgCompilerVersion :: forall a. Package a -> Version
pkgUploader :: forall a. Package a -> a
pkgGithub :: forall a. Package a -> (GithubUser, GithubRepo)
pkgResolvedDependencies :: forall a. Package a -> [(PackageName, Version)]
pkgModuleMap :: forall a. Package a -> Map ModuleName PackageName
pkgModules :: forall a. Package a -> [Module]
pkgTagTime :: forall a. Package a -> Maybe UTCTime
pkgVersionTag :: forall a. Package a -> Text
pkgVersion :: forall a. Package a -> Version
pkgMeta :: forall a. Package a -> PackageMeta
..} =
  LinksContext
    { ctxGithub :: (GithubUser, GithubRepo)
ctxGithub               = (GithubUser, GithubRepo)
pkgGithub
    , ctxModuleMap :: Map ModuleName PackageName
ctxModuleMap            = Map ModuleName PackageName
pkgModuleMap
    , ctxResolvedDependencies :: [(PackageName, Version)]
ctxResolvedDependencies = [(PackageName, Version)]
pkgResolvedDependencies
    , ctxPackageName :: PackageName
ctxPackageName          = PackageMeta -> PackageName
bowerName PackageMeta
pkgMeta
    , ctxVersion :: Version
ctxVersion              = Version
pkgVersion
    , ctxVersionTag :: Text
ctxVersionTag           = Text
pkgVersionTag
    }

----------------------
-- Parsing

asPackage :: Version -> (forall e. Parse e a) -> Parse PackageError (Package a)
asPackage :: forall a.
Version -> (forall e. Parse e a) -> Parse PackageError (Package a)
asPackage Version
minimumVersion forall e. Parse e a
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.
  Version
compilerVersion <- forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"compilerVersion" ([Int] -> [String] -> Version
Version [Int
0,Int
7,Int
0,Int
0] []) Parse PackageError Version
asVersion
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
compilerVersion forall a. Ord a => a -> a -> Bool
< Version
minimumVersion)
    (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
err -> ParseT err m a
throwCustomError forall a b. (a -> b) -> a -> b
$ Version -> Version -> PackageError
CompilerTooOld Version
minimumVersion Version
compilerVersion)

  forall a.
PackageMeta
-> Version
-> Text
-> Maybe UTCTime
-> [Module]
-> Map ModuleName PackageName
-> [(PackageName, Version)]
-> (GithubUser, GithubRepo)
-> a
-> Version
-> Package a
Package forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"packageMeta" Parse BowerError PackageMeta
asPackageMeta forall (m :: * -> *) err a err'.
Functor m =>
ParseT err m a -> (err -> err') -> ParseT err' m a
.! (ManifestError -> PackageError
ErrorInPackageMeta forall b c a. (b -> c) -> (a -> b) -> a -> c
. BowerError -> ManifestError
BowerManifest)
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"version" Parse PackageError Version
asVersion
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"versionTag" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
keyMay Text
"tagTime" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(String -> Either err a) -> ParseT err m a
withString String -> Either PackageError UTCTime
parseTimeEither)
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"modules" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse PackageError Module
asModule)
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parse PackageError (Map ModuleName PackageName)
moduleMap
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"resolvedDependencies" Parse PackageError [(PackageName, Version)]
asResolvedDependencies
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"github" forall e. Parse e (GithubUser, GithubRepo)
asGithub
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"uploader" forall e. Parse e a
uploader
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
compilerVersion
  where
  moduleMap :: Parse PackageError (Map ModuleName PackageName)
moduleMap =
    forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"moduleMap" Parse PackageError (Map ModuleName PackageName)
asModuleMap
    forall e a. Parse e a -> Parse e a -> Parse e a
`pOr` (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"bookmarks" Parse ManifestError (Map ModuleName PackageName)
bookmarksAsModuleMap forall (m :: * -> *) err a err'.
Functor m =>
ParseT err m a -> (err -> err') -> ParseT err' m a
.! ManifestError -> PackageError
ErrorInPackageMeta)

parseTimeEither :: String -> Either PackageError UTCTime
parseTimeEither :: String -> Either PackageError UTCTime
parseTimeEither =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left PackageError
InvalidTime) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe UTCTime
parseTime

asUploadedPackage :: Version -> Parse PackageError UploadedPackage
asUploadedPackage :: Version -> Parse PackageError UploadedPackage
asUploadedPackage Version
minVersion = forall a.
Version -> (forall e. Parse e a) -> Parse PackageError (Package a)
asPackage Version
minVersion forall e. Parse e NotYetKnown
asNotYetKnown

asNotYetKnown :: Parse e NotYetKnown
asNotYetKnown :: forall e. Parse e NotYetKnown
asNotYetKnown = NotYetKnown
NotYetKnown forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m ()
asNull

instance A.FromJSON NotYetKnown where
  parseJSON :: Value -> Parser NotYetKnown
parseJSON = forall a. Parse' a -> Value -> Parser a
toAesonParser' forall e. Parse e NotYetKnown
asNotYetKnown

displayPackageError :: PackageError -> Text
displayPackageError :: PackageError -> Text
displayPackageError PackageError
e = case PackageError
e of
  CompilerTooOld Version
minV Version
usedV ->
    Text
"Expecting data produced by at least version " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Version -> String
showVersion Version
minV)
    forall a. Semigroup a => a -> a -> a
<> Text
" of the compiler, but it appears that " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Version -> String
showVersion Version
usedV)
    forall a. Semigroup a => a -> a -> a
<> Text
" was used."
  ErrorInPackageMeta ManifestError
err ->
    Text
"Error in package metadata: " forall a. Semigroup a => a -> a -> a
<> ManifestError -> Text
showManifestError ManifestError
err
  PackageError
InvalidVersion ->
    Text
"Invalid version"
  InvalidDeclarationType Text
str ->
    Text
"Invalid declaration type: \"" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\""
  InvalidChildDeclarationType Text
str ->
    Text
"Invalid child declaration type: \"" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\""
  PackageError
InvalidFixity ->
    Text
"Invalid fixity"
  InvalidKind Text
str ->
    Text
"Invalid kind: \"" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\""
  InvalidDataDeclType Text
str ->
    Text
"Invalid data declaration type: \"" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\""
  InvalidKindSignatureFor Text
str ->
    Text
"Invalid kind signature keyword: \"" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\""
  PackageError
InvalidTime ->
    Text
"Invalid time"
  InvalidRole Text
str ->
    Text
"Invalid role keyword: \"" forall a. Semigroup a => a -> a -> a
<> Text
str forall a. Semigroup a => a -> a -> a
<> Text
"\""

instance A.FromJSON a => A.FromJSON (Package a) where
  parseJSON :: Value -> Parser (Package a)
parseJSON = forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser PackageError -> Text
displayPackageError
                            (forall a.
Version -> (forall e. Parse e a) -> Parse PackageError (Package a)
asPackage ([Int] -> [String] -> Version
Version [Int
0,Int
0,Int
0,Int
0] []) forall (m :: * -> *) a e.
(Functor m, Monad m, FromJSON a) =>
ParseT e m a
fromAesonParser)

asGithubUser :: Parse e GithubUser
asGithubUser :: forall e. Parse e GithubUser
asGithubUser = Text -> GithubUser
GithubUser forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText

instance A.FromJSON GithubUser where
  parseJSON :: Value -> Parser GithubUser
parseJSON = forall a. Parse' a -> Value -> Parser a
toAesonParser' forall e. Parse e GithubUser
asGithubUser

asVersion :: Parse PackageError Version
asVersion :: Parse PackageError Version
asVersion = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(String -> Either err a) -> ParseT err m a
withString (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left PackageError
InvalidVersion) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Version
P.parseVersion')

asModule :: Parse PackageError Module
asModule :: Parse PackageError Module
asModule =
  ModuleName
-> Maybe Text
-> [Declaration]
-> [(InPackage ModuleName, [Declaration])]
-> Module
Module forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"name" (Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"comments" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"declarations" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse PackageError Declaration
asDeclaration)
         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"reExports" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse PackageError (InPackage ModuleName, [Declaration])
asReExport)

asDeclaration :: Parse PackageError Declaration
asDeclaration :: Parse PackageError Declaration
asDeclaration =
  Text
-> Maybe Text
-> Maybe SourceSpan
-> [ChildDeclaration]
-> DeclarationInfo
-> Maybe KindInfo
-> Declaration
Declaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"title" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"comments" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"sourceSpan" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps forall e. Parse e SourceSpan
asSourceSpan)
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"children" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse PackageError ChildDeclaration
asChildDeclaration)
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"info" Parse PackageError DeclarationInfo
asDeclarationInfo
              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"kind" forall a. Maybe a
Nothing (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps Parse PackageError KindInfo
asKindInfo)

asReExport :: Parse PackageError (InPackage P.ModuleName, [Declaration])
asReExport :: Parse PackageError (InPackage ModuleName, [Declaration])
asReExport =
  (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"moduleName" Parse PackageError (InPackage ModuleName)
asReExportModuleName
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"declarations" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse PackageError Declaration
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 :: Parse PackageError (InPackage ModuleName)
asReExportModuleName =
    forall a.
Parse ManifestError a -> Parse ManifestError (InPackage a)
asInPackage forall (m :: * -> *) a e.
(Functor m, Monad m, FromJSON a) =>
ParseT e m a
fromAesonParser forall (m :: * -> *) err a err'.
Functor m =>
ParseT err m a -> (err -> err') -> ParseT err' m a
.! ManifestError -> PackageError
ErrorInPackageMeta
    forall e a. Parse e a -> Parse e a -> Parse e a
`pOr` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> InPackage a
Local forall (m :: * -> *) a e.
(Functor m, Monad m, FromJSON a) =>
ParseT e m a
fromAesonParser

pOr :: Parse e a -> Parse e a -> Parse e a
Parse e a
p pOr :: forall e a. Parse e a -> Parse e a -> Parse e a
`pOr` Parse e a
q = forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError Parse e a
p (forall a b. a -> b -> a
const Parse e a
q)

asInPackage :: Parse ManifestError a -> Parse ManifestError (InPackage a)
asInPackage :: forall a.
Parse ManifestError a -> Parse ManifestError (InPackage a)
asInPackage Parse ManifestError a
inner =
  forall {a}. Maybe PackageName -> a -> InPackage a
build forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"package" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText (forall a a' b. (a -> a') -> Either a b -> Either a' b
mapLeft BowerError -> ManifestError
BowerManifest forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either BowerError PackageName
parsePackageName)))
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"item" Parse ManifestError a
inner
  where
  build :: Maybe PackageName -> a -> InPackage a
build Maybe PackageName
Nothing = forall a. a -> InPackage a
Local
  build (Just PackageName
pn) = forall a. PackageName -> a -> InPackage a
FromDep PackageName
pn

asFixity :: Parse PackageError P.Fixity
asFixity :: Parse PackageError Fixity
asFixity =
  Associativity -> Precedence -> Fixity
P.Fixity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"associativity" Parse PackageError Associativity
asAssociativity
           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"precedence" forall (m :: * -> *) a err.
(Functor m, Monad m, Integral a) =>
ParseT err m a
asIntegral

asFixityAlias :: Parse PackageError FixityAlias
asFixityAlias :: Parse PackageError FixityAlias
asFixityAlias = forall (m :: * -> *) a e.
(Functor m, Monad m, FromJSON a) =>
ParseT e m a
fromAesonParser

parseAssociativity :: String -> Maybe P.Associativity
parseAssociativity :: String -> Maybe Associativity
parseAssociativity String
str = case String
str of
  String
"infix"  -> forall a. a -> Maybe a
Just Associativity
P.Infix
  String
"infixl" -> forall a. a -> Maybe a
Just Associativity
P.Infixl
  String
"infixr" -> forall a. a -> Maybe a
Just Associativity
P.Infixr
  String
_        -> forall a. Maybe a
Nothing

asAssociativity :: Parse PackageError P.Associativity
asAssociativity :: Parse PackageError Associativity
asAssociativity = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(String -> Either err a) -> ParseT err m a
withString (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left PackageError
InvalidFixity) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Associativity
parseAssociativity)

asDeclarationInfo :: Parse PackageError DeclarationInfo
asDeclarationInfo :: Parse PackageError DeclarationInfo
asDeclarationInfo = do
  Text
ty <- forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"declType" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
  case Text
ty of
    Text
"value" ->
      Type' -> DeclarationInfo
ValueDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"type" forall e. Parse e Type'
asType
    Text
"data" ->
      DataDeclType -> [(Text, Maybe Type')] -> [Role] -> DeclarationInfo
DataDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"dataDeclType" Parse PackageError DataDeclType
asDataDeclType
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"typeArguments" Parse PackageError [(Text, Maybe Type')]
asTypeArguments
                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"roles" [] (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse PackageError Role
asRole)
    Text
"externData" ->
      Type' -> [Role] -> DeclarationInfo
ExternDataDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"kind" forall e. Parse e Type'
asType
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"roles" [] (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse PackageError Role
asRole)
    Text
"typeSynonym" ->
      [(Text, Maybe Type')] -> Type' -> DeclarationInfo
TypeSynonymDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"arguments" Parse PackageError [(Text, Maybe Type')]
asTypeArguments
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"type" forall e. Parse e Type'
asType
    Text
"typeClass" ->
      [(Text, Maybe Type')]
-> [Constraint'] -> [([Text], [Text])] -> DeclarationInfo
TypeClassDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"arguments" Parse PackageError [(Text, Maybe Type')]
asTypeArguments
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"superclasses" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse PackageError Constraint'
asConstraint)
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"fundeps" [] Parse PackageError [([Text], [Text])]
asFunDeps
    Text
"alias" ->
      Fixity -> FixityAlias -> DeclarationInfo
AliasDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"fixity" Parse PackageError Fixity
asFixity
                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"alias" Parse PackageError FixityAlias
asFixityAlias
    -- Backwards compat: kinds are extern data
    Text
"kind" ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Type' -> [Role] -> DeclarationInfo
ExternDataDeclaration (SourceType
P.kindType forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) []
    Text
other ->
      forall (m :: * -> *) err a.
(Functor m, Monad m) =>
err -> ParseT err m a
throwCustomError (Text -> PackageError
InvalidDeclarationType Text
other)

asKindInfo :: Parse PackageError KindInfo
asKindInfo :: Parse PackageError KindInfo
asKindInfo =
  KindSignatureFor -> Type' -> KindInfo
KindInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"keyword" Parse PackageError KindSignatureFor
asKindSignatureFor
           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"kind" forall e. Parse e Type'
asType

asKindSignatureFor :: Parse PackageError P.KindSignatureFor
asKindSignatureFor :: Parse PackageError KindSignatureFor
asKindSignatureFor =
  forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText forall a b. (a -> b) -> a -> b
$ \case
    Text
"data" -> forall a b. b -> Either a b
Right KindSignatureFor
P.DataSig
    Text
"newtype" -> forall a b. b -> Either a b
Right KindSignatureFor
P.NewtypeSig
    Text
"class" -> forall a b. b -> Either a b
Right KindSignatureFor
P.ClassSig
    Text
"type" -> forall a b. b -> Either a b
Right KindSignatureFor
P.TypeSynonymSig
    Text
x -> forall a b. a -> Either a b
Left (Text -> PackageError
InvalidKindSignatureFor Text
x)

asTypeArguments :: Parse PackageError [(Text, Maybe Type')]
asTypeArguments :: Parse PackageError [(Text, Maybe Type')]
asTypeArguments = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall {err}. ParseT err Identity (Text, Maybe Type')
asTypeArgument
  where
  asTypeArgument :: ParseT err Identity (Text, Maybe Type')
asTypeArgument = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
0 forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
1 (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps forall e. Parse e Type'
asType)

asRole :: Parse PackageError P.Role
asRole :: Parse PackageError Role
asRole =
  forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText forall a b. (a -> b) -> a -> b
$ \case
    Text
"Representational" -> forall a b. b -> Either a b
Right Role
P.Representational
    Text
"Nominal" -> forall a b. b -> Either a b
Right Role
P.Nominal
    Text
"Phantom" -> forall a b. b -> Either a b
Right Role
P.Phantom
    Text
other -> forall a b. a -> Either a b
Left (Text -> PackageError
InvalidRole Text
other)

asType :: Parse e Type'
asType :: forall e. Parse e Type'
asType = forall (m :: * -> *) a e.
(Functor m, Monad m, FromJSON a) =>
ParseT e m a
fromAesonParser

asFunDeps :: Parse PackageError [([Text], [Text])]
asFunDeps :: Parse PackageError [([Text], [Text])]
asFunDeps = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall {err}. ParseT err Identity ([Text], [Text])
asFunDep
  where
  asFunDep :: ParseT err Identity ([Text], [Text])
asFunDep = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
0 (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
1 (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)

asDataDeclType :: Parse PackageError P.DataDeclType
asDataDeclType :: Parse PackageError DataDeclType
asDataDeclType =
  forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText forall a b. (a -> b) -> a -> b
$ \case
    Text
"data"    -> forall a b. b -> Either a b
Right DataDeclType
P.Data
    Text
"newtype" -> forall a b. b -> Either a b
Right DataDeclType
P.Newtype
    Text
other     -> forall a b. a -> Either a b
Left (Text -> PackageError
InvalidDataDeclType Text
other)

asChildDeclaration :: Parse PackageError ChildDeclaration
asChildDeclaration :: Parse PackageError ChildDeclaration
asChildDeclaration =
  Text
-> Maybe Text
-> Maybe SourceSpan
-> ChildDeclarationInfo
-> ChildDeclaration
ChildDeclaration forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"title" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"comments" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"sourceSpan" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps forall e. Parse e SourceSpan
asSourceSpan)
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"info" Parse PackageError ChildDeclarationInfo
asChildDeclarationInfo

asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo
asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo
asChildDeclarationInfo = do
  Text
ty <- forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"declType" forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText
  case Text
ty of
    Text
"instance" ->
      [Constraint'] -> Type' -> ChildDeclarationInfo
ChildInstance forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"dependencies" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray Parse PackageError Constraint'
asConstraint)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"type" forall e. Parse e Type'
asType
    Text
"dataConstructor" ->
      [Type'] -> ChildDeclarationInfo
ChildDataConstructor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"arguments" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall e. Parse e Type'
asType)
    Text
"typeClassMember" ->
      Type' -> ChildDeclarationInfo
ChildTypeClassMember forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"type" forall e. Parse e Type'
asType
    Text
other ->
      forall (m :: * -> *) err a.
(Functor m, Monad m) =>
err -> ParseT err m a
throwCustomError forall a b. (a -> b) -> a -> b
$ Text -> PackageError
InvalidChildDeclarationType Text
other

asSourcePos :: Parse e P.SourcePos
asSourcePos :: forall e. Parse e SourcePos
asSourcePos = Int -> Int -> SourcePos
P.SourcePos forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
0 forall (m :: * -> *) a err.
(Functor m, Monad m, Integral a) =>
ParseT err m a
asIntegral
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
1 forall (m :: * -> *) a err.
(Functor m, Monad m, Integral a) =>
ParseT err m a
asIntegral

asConstraint :: Parse PackageError Constraint'
asConstraint :: Parse PackageError Constraint'
asConstraint = forall a.
a
-> Qualified (ProperName 'ClassName)
-> [Type a]
-> [Type a]
-> Maybe ConstraintData
-> Constraint a
P.Constraint () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"constraintClass" forall e (a :: ProperNameType). Parse e (Qualified (ProperName a))
asQualifiedProperName
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
"constraintKindArgs" [] (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall e. Parse e Type'
asType)
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"constraintArgs" (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray forall e. Parse e Type'
asType)
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

asQualifiedProperName :: Parse e (P.Qualified (P.ProperName a))
asQualifiedProperName :: forall e (a :: ProperNameType). Parse e (Qualified (ProperName a))
asQualifiedProperName = forall (m :: * -> *) a e.
(Functor m, Monad m, FromJSON a) =>
ParseT e m a
fromAesonParser

asModuleMap :: Parse PackageError (Map P.ModuleName PackageName)
asModuleMap :: Parse PackageError (Map ModuleName PackageName)
asModuleMap =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (m :: * -> *) err k a.
(Functor m, Monad m) =>
(Text -> Either err k) -> ParseT err m a -> ParseT err m [(k, a)]
eachInObjectWithKey (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ModuleName
P.moduleNameFromString)
                        (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText Text -> Either PackageError PackageName
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 :: Parse ManifestError (Map ModuleName PackageName)
bookmarksAsModuleMap =
  [InPackage ModuleName] -> Map ModuleName PackageName
convert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray (forall a.
Parse ManifestError a -> Parse ManifestError (InPackage a)
asInPackage (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
0 (Text -> ModuleName
P.moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)))

  where
  convert :: [InPackage P.ModuleName] -> Map P.ModuleName PackageName
  convert :: [InPackage ModuleName] -> Map ModuleName PackageName
convert = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. InPackage a -> Maybe (a, PackageName)
toTuple

  toTuple :: InPackage a -> Maybe (a, PackageName)
toTuple (Local a
_) = forall a. Maybe a
Nothing
  toTuple (FromDep PackageName
pkgName a
mn) = forall a. a -> Maybe a
Just (a
mn, PackageName
pkgName)

asResolvedDependencies :: Parse PackageError [(PackageName, Version)]
asResolvedDependencies :: Parse PackageError [(PackageName, Version)]
asResolvedDependencies =
  forall (m :: * -> *) err k a.
(Functor m, Monad m) =>
(Text -> Either err k) -> ParseT err m a -> ParseT err m [(k, a)]
eachInObjectWithKey Text -> Either PackageError PackageName
parsePackageName' Parse PackageError Version
asVersion

parsePackageName' :: Text -> Either PackageError PackageName
parsePackageName' :: Text -> Either PackageError PackageName
parsePackageName' =
  forall a a' b. (a -> a') -> Either a b -> Either a' b
mapLeft ManifestError -> PackageError
ErrorInPackageMeta forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a a' b. (a -> a') -> Either a b -> Either a' b
mapLeft BowerError -> ManifestError
BowerManifest forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either BowerError PackageName
parsePackageName)

mapLeft :: (a -> a') -> Either a b -> Either a' b
mapLeft :: forall a a' b. (a -> a') -> Either a b -> Either a' b
mapLeft a -> a'
f (Left a
x) = forall a b. a -> Either a b
Left (a -> a'
f a
x)
mapLeft a -> a'
_ (Right b
x) = forall a b. b -> Either a b
Right b
x

asGithub :: Parse e (GithubUser, GithubRepo)
asGithub :: forall e. Parse e (GithubUser, GithubRepo)
asGithub = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
0 (Text -> GithubUser
GithubUser forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
1 (Text -> GithubRepo
GithubRepo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText)

asSourceSpan :: Parse e P.SourceSpan
asSourceSpan :: forall e. Parse e SourceSpan
asSourceSpan = String -> SourcePos -> SourcePos -> SourceSpan
P.SourceSpan forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"name" forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m String
asString
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"start" forall e. Parse e SourcePos
asSourcePos
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
"end" forall e. Parse e SourcePos
asSourcePos

---------------------
-- ToJSON instances

instance A.ToJSON a => A.ToJSON (Package a) where
  toJSON :: Package a -> Value
toJSON Package{a
[(PackageName, Version)]
[Module]
Maybe UTCTime
(GithubUser, GithubRepo)
Version
Map ModuleName PackageName
Text
PackageMeta
pkgCompilerVersion :: Version
pkgUploader :: a
pkgGithub :: (GithubUser, GithubRepo)
pkgResolvedDependencies :: [(PackageName, Version)]
pkgModuleMap :: Map ModuleName PackageName
pkgModules :: [Module]
pkgTagTime :: Maybe UTCTime
pkgVersionTag :: Text
pkgVersion :: Version
pkgMeta :: PackageMeta
pkgCompilerVersion :: forall a. Package a -> Version
pkgUploader :: forall a. Package a -> a
pkgGithub :: forall a. Package a -> (GithubUser, GithubRepo)
pkgResolvedDependencies :: forall a. Package a -> [(PackageName, Version)]
pkgModuleMap :: forall a. Package a -> Map ModuleName PackageName
pkgModules :: forall a. Package a -> [Module]
pkgTagTime :: forall a. Package a -> Maybe UTCTime
pkgVersionTag :: forall a. Package a -> Text
pkgVersion :: forall a. Package a -> Version
pkgMeta :: forall a. Package a -> PackageMeta
..} =
    [Pair] -> Value
A.object forall a b. (a -> b) -> a -> b
$
      [ Key
"packageMeta"          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PackageMeta
pkgMeta
      , Key
"version"              forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Version -> String
showVersion Version
pkgVersion
      , Key
"versionTag"           forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
pkgVersionTag
      , Key
"modules"              forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Module]
pkgModules
      , Key
"moduleMap"            forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> Key) -> (b -> Text) -> [(a, b)] -> Value
assocListToJSON (Text -> Key
A.Key.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
P.runModuleName)
                                                  PackageName -> Text
runPackageName
                                                  (forall k a. Map k a -> [(k, a)]
Map.toList Map ModuleName PackageName
pkgModuleMap)
      , Key
"resolvedDependencies" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> Key) -> (b -> Text) -> [(a, b)] -> Value
assocListToJSON (Text -> Key
A.Key.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Text
runPackageName)
                                                  (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion)
                                                  [(PackageName, Version)]
pkgResolvedDependencies
      , Key
"github"               forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (GithubUser, GithubRepo)
pkgGithub
      , Key
"uploader"             forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
pkgUploader
      , Key
"compilerVersion"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Version -> String
showVersion Version
Paths.version
      ] forall a. [a] -> [a] -> [a]
++
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\UTCTime
t -> Key
"tagTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime -> String
formatTime UTCTime
t) (forall a. Maybe a -> [a]
maybeToList Maybe UTCTime
pkgTagTime)

instance A.ToJSON NotYetKnown where
  toJSON :: NotYetKnown -> Value
toJSON NotYetKnown
_ = Value
A.Null

instance A.ToJSON Module where
  toJSON :: Module -> Value
toJSON Module{[(InPackage ModuleName, [Declaration])]
[Declaration]
Maybe Text
ModuleName
modReExports :: [(InPackage ModuleName, [Declaration])]
modDeclarations :: [Declaration]
modComments :: Maybe Text
modName :: ModuleName
modReExports :: Module -> [(InPackage ModuleName, [Declaration])]
modDeclarations :: Module -> [Declaration]
modComments :: Module -> Maybe Text
modName :: Module -> ModuleName
..} =
    [Pair] -> Value
A.object [ Key
"name"         forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ModuleName -> Text
P.runModuleName ModuleName
modName
             , Key
"comments"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
modComments
             , Key
"declarations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Declaration]
modDeclarations
             , Key
"reExports"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall {v} {v}. (ToJSON v, ToJSON v) => (v, v) -> Value
toObj [(InPackage ModuleName, [Declaration])]
modReExports
             ]
    where
    toObj :: (v, v) -> Value
toObj (v
mn, v
decls) = [Pair] -> Value
A.object [ Key
"moduleName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
mn
                                 , Key
"declarations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
decls
                                 ]

instance A.ToJSON Declaration where
  toJSON :: Declaration -> Value
toJSON Declaration{[ChildDeclaration]
Maybe Text
Maybe SourceSpan
Maybe KindInfo
Text
DeclarationInfo
declKind :: Maybe KindInfo
declInfo :: DeclarationInfo
declChildren :: [ChildDeclaration]
declSourceSpan :: Maybe SourceSpan
declComments :: Maybe Text
declTitle :: Text
declKind :: Declaration -> Maybe KindInfo
declInfo :: Declaration -> DeclarationInfo
declChildren :: Declaration -> [ChildDeclaration]
declSourceSpan :: Declaration -> Maybe SourceSpan
declComments :: Declaration -> Maybe Text
declTitle :: Declaration -> Text
..} =
    [Pair] -> Value
A.object [ Key
"title"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
declTitle
             , Key
"comments"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
declComments
             , Key
"sourceSpan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe SourceSpan
declSourceSpan
             , Key
"children"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ChildDeclaration]
declChildren
             , Key
"info"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DeclarationInfo
declInfo
             , Key
"kind"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe KindInfo
declKind
             ]

instance A.ToJSON KindInfo where
 toJSON :: KindInfo -> Value
toJSON KindInfo{Type'
KindSignatureFor
kiKind :: Type'
kiKeyword :: KindSignatureFor
kiKind :: KindInfo -> Type'
kiKeyword :: KindInfo -> KindSignatureFor
..} =
   [Pair] -> Value
A.object [ Key
"keyword" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= KindSignatureFor -> Text
kindSignatureForKeyword KindSignatureFor
kiKeyword
            , Key
"kind"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Type'
kiKind
            ]

kindSignatureForKeyword :: P.KindSignatureFor -> Text
kindSignatureForKeyword :: KindSignatureFor -> Text
kindSignatureForKeyword = \case
  KindSignatureFor
P.DataSig -> Text
"data"
  KindSignatureFor
P.NewtypeSig -> Text
"newtype"
  KindSignatureFor
P.TypeSynonymSig -> Text
"type"
  KindSignatureFor
P.ClassSig -> Text
"class"

instance A.ToJSON ChildDeclaration where
  toJSON :: ChildDeclaration -> Value
toJSON ChildDeclaration{Maybe Text
Maybe SourceSpan
Text
ChildDeclarationInfo
cdeclInfo :: ChildDeclarationInfo
cdeclSourceSpan :: Maybe SourceSpan
cdeclComments :: Maybe Text
cdeclTitle :: Text
cdeclInfo :: ChildDeclaration -> ChildDeclarationInfo
cdeclSourceSpan :: ChildDeclaration -> Maybe SourceSpan
cdeclComments :: ChildDeclaration -> Maybe Text
cdeclTitle :: ChildDeclaration -> Text
..} =
    [Pair] -> Value
A.object [ Key
"title"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
cdeclTitle
             , Key
"comments"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
cdeclComments
             , Key
"sourceSpan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe SourceSpan
cdeclSourceSpan
             , Key
"info"       forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ChildDeclarationInfo
cdeclInfo
             ]

instance A.ToJSON DeclarationInfo where
  toJSON :: DeclarationInfo -> Value
toJSON DeclarationInfo
info = [Pair] -> Value
A.object forall a b. (a -> b) -> a -> b
$ Key
"declType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DeclarationInfo -> Text
declInfoToString DeclarationInfo
info forall a. a -> [a] -> [a]
: [Pair]
props
    where
    props :: [Pair]
props = case DeclarationInfo
info of
      ValueDeclaration Type'
ty -> [Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Type'
ty]
      DataDeclaration DataDeclType
ty [(Text, Maybe Type')]
args [Role]
roles -> [Key
"dataDeclType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DataDeclType
ty, Key
"typeArguments" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Text, Maybe Type')]
args, Key
"roles" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Role]
roles]
      ExternDataDeclaration Type'
kind [Role]
roles -> [Key
"kind" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Type'
kind, Key
"roles" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Role]
roles]
      TypeSynonymDeclaration [(Text, Maybe Type')]
args Type'
ty -> [Key
"arguments" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Text, Maybe Type')]
args, Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Type'
ty]
      TypeClassDeclaration [(Text, Maybe Type')]
args [Constraint']
super [([Text], [Text])]
fundeps -> [Key
"arguments" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Text, Maybe Type')]
args, Key
"superclasses" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Constraint']
super, Key
"fundeps" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [([Text], [Text])]
fundeps]
      AliasDeclaration Fixity
fixity FixityAlias
alias -> [Key
"fixity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Fixity
fixity, Key
"alias" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FixityAlias
alias]

instance A.ToJSON ChildDeclarationInfo where
  toJSON :: ChildDeclarationInfo -> Value
toJSON ChildDeclarationInfo
info = [Pair] -> Value
A.object forall a b. (a -> b) -> a -> b
$ Key
"declType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ChildDeclarationInfo -> Text
childDeclInfoToString ChildDeclarationInfo
info forall a. a -> [a] -> [a]
: [Pair]
props
    where
    props :: [Pair]
props = case ChildDeclarationInfo
info of
      ChildInstance [Constraint']
deps Type'
ty     -> [Key
"dependencies" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Constraint']
deps, Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Type'
ty]
      ChildDataConstructor [Type']
args -> [Key
"arguments" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Type']
args]
      ChildTypeClassMember Type'
ty   -> [Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Type'
ty]

instance A.ToJSON GithubUser where
  toJSON :: GithubUser -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. GithubUser -> Text
runGithubUser

instance A.ToJSON GithubRepo where
  toJSON :: GithubRepo -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. GithubRepo -> Text
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 :: forall a b. (a -> Key) -> (b -> Text) -> [(a, b)] -> Value
assocListToJSON a -> Key
f b -> Text
g [(a, b)]
xs = [Pair] -> Value
A.object (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
(.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Key
f forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** b -> Text
g)) [(a, b)]
xs)

instance A.ToJSON a => A.ToJSON (InPackage a) where
  toJSON :: InPackage a -> Value
toJSON InPackage a
x =
    case InPackage a
x of
      Local a
y      -> forall p x. (ToJSON p, ToJSON x) => p -> x -> Value
withPackage (forall a. Maybe a
Nothing :: Maybe ()) a
y
      FromDep PackageName
pn a
y -> forall p x. (ToJSON p, ToJSON x) => p -> x -> Value
withPackage (forall a. a -> Maybe a
Just PackageName
pn) a
y
    where
    withPackage :: (A.ToJSON p, A.ToJSON x) => p -> x -> A.Value
    withPackage :: forall p x. (ToJSON p, ToJSON x) => p -> x -> Value
withPackage p
p x
y =
      [Pair] -> Value
A.object [ Key
"package" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= p
p
               , Key
"item"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= x
y
               ]