-- | This module defines a normalised representation of APIs, used for
-- comparing them in the migrations changelog, and to analyse dependencies.
module Data.API.NormalForm
    ( -- * Normalised API types
      NormAPI
    , NormTypeDecl(..)
    , NormRecordType
    , NormUnionType
    , NormEnumType

      -- * Converting to normal form
    , apiNormalForm
    , declNF

      -- * Dependency analysis
    , typeDeclsFreeVars
    , typeDeclFreeVars
    , typeFreeVars
    , typeDeclaredInApi
    , typeUsedInApi
    , typeUsedInTransitiveDep
    , transitiveDeps
    , transitiveReverseDeps

      -- * Invariant validation
    , apiInvariant
    , declIsValid
    , typeIsValid

      -- * Modifying types
    , substTypeDecl
    , substType
    , renameTypeUses
    ) where

import           Data.API.PP
import           Data.API.Types

import           Control.DeepSeq
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Set (Set)
import qualified Data.Set as Set


-- | The API type has too much extra info for us to be able to simply compare
-- them with @(==)@. Our strategy is to strip out ancillary information and
-- normalise into a canonical form, and then we can use a simple @(==)@ compare.
--
-- Our normalised API discards most of the details of each type, keeping
-- just essential information about each type. We discard order of types and
-- fields, so we can use just associative maps.
--
type NormAPI = Map TypeName NormTypeDecl

-- | The normal or canonical form for a type declaration, an 'APINode'.
-- Equality of the normal form indicates equivalence of APIs.
--
-- We track all types.
--
data NormTypeDecl
    = NRecordType  NormRecordType
    | NUnionType   NormUnionType
    | NEnumType    NormEnumType
    | NTypeSynonym APIType
    | NNewtype     BasicType
  deriving (NormTypeDecl -> NormTypeDecl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormTypeDecl -> NormTypeDecl -> Bool
$c/= :: NormTypeDecl -> NormTypeDecl -> Bool
== :: NormTypeDecl -> NormTypeDecl -> Bool
$c== :: NormTypeDecl -> NormTypeDecl -> Bool
Eq, Int -> NormTypeDecl -> ShowS
[NormTypeDecl] -> ShowS
NormTypeDecl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NormTypeDecl] -> ShowS
$cshowList :: [NormTypeDecl] -> ShowS
show :: NormTypeDecl -> String
$cshow :: NormTypeDecl -> String
showsPrec :: Int -> NormTypeDecl -> ShowS
$cshowsPrec :: Int -> NormTypeDecl -> ShowS
Show)

instance NFData NormTypeDecl where
  rnf :: NormTypeDecl -> ()
rnf (NRecordType  NormRecordType
x) = forall a. NFData a => a -> ()
rnf NormRecordType
x
  rnf (NUnionType   NormRecordType
x) = forall a. NFData a => a -> ()
rnf NormRecordType
x
  rnf (NEnumType    NormEnumType
x) = forall a. NFData a => a -> ()
rnf NormEnumType
x
  rnf (NTypeSynonym APIType
x) = forall a. NFData a => a -> ()
rnf APIType
x
  rnf (NNewtype     BasicType
x) = forall a. NFData a => a -> ()
rnf BasicType
x

-- | The canonical form of a record type is a map from fields to
-- values...
type NormRecordType = Map FieldName APIType
-- | ...similarly a union is a map from fields to alternatives...
type NormUnionType  = Map FieldName APIType
-- | ...and an enum is a set of values.
type NormEnumType   = Set FieldName


-- | Compute the normal form of an API, discarding extraneous information.
apiNormalForm :: API -> NormAPI
apiNormalForm :: API -> NormAPI
apiNormalForm API
api =
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (TypeName
name, Spec -> NormTypeDecl
declNF Spec
spec)
      | ThNode (APINode {anName :: APINode -> TypeName
anName = TypeName
name, anSpec :: APINode -> Spec
anSpec = Spec
spec}) <- API
api ]

-- | Compute the normal form of a single type declaration.
declNF :: Spec -> NormTypeDecl
declNF :: Spec -> NormTypeDecl
declNF (SpRecord (SpecRecord [(FieldName, FieldType)]
fields)) = NormRecordType -> NormTypeDecl
NRecordType forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                                          [ (FieldName
fname, FieldType -> APIType
ftType FieldType
ftype)
                                          | (FieldName
fname, FieldType
ftype) <- [(FieldName, FieldType)]
fields ]
declNF (SpUnion (SpecUnion [(FieldName, (APIType, String))]
alts))     = NormRecordType -> NormTypeDecl
NUnionType forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                                          [ (FieldName
fname, APIType
ftype)
                                          | (FieldName
fname, (APIType
ftype, String
_)) <- [(FieldName, (APIType, String))]
alts ]
declNF (SpEnum (SpecEnum [(FieldName, String)]
elems))      = NormEnumType -> NormTypeDecl
NEnumType forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList
                                          [ FieldName
fname | (FieldName
fname, String
_) <- [(FieldName, String)]
elems ]
declNF (SpSynonym APIType
t)                  = APIType -> NormTypeDecl
NTypeSynonym APIType
t
declNF (SpNewtype (SpecNewtype BasicType
bt Maybe Filter
_)) = BasicType -> NormTypeDecl
NNewtype BasicType
bt


-------------------------
-- Dependency analysis
--

-- | Find the set of type names used in an API
typeDeclsFreeVars :: NormAPI -> Set TypeName
typeDeclsFreeVars :: NormAPI -> Set TypeName
typeDeclsFreeVars = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map NormTypeDecl -> Set TypeName
typeDeclFreeVars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems

-- | Find the set of type names used in a declaration
typeDeclFreeVars :: NormTypeDecl -> Set TypeName
typeDeclFreeVars :: NormTypeDecl -> Set TypeName
typeDeclFreeVars (NRecordType NormRecordType
fields) = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map APIType -> Set TypeName
typeFreeVars
                                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ NormRecordType
fields
typeDeclFreeVars (NUnionType  NormRecordType
alts)   = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map APIType -> Set TypeName
typeFreeVars
                                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ NormRecordType
alts
typeDeclFreeVars (NEnumType NormEnumType
_)        = forall a. Set a
Set.empty
typeDeclFreeVars (NTypeSynonym APIType
t)     = APIType -> Set TypeName
typeFreeVars APIType
t
typeDeclFreeVars (NNewtype BasicType
_)         = forall a. Set a
Set.empty

-- | Find the set of type names used in an type
typeFreeVars :: APIType -> Set TypeName
typeFreeVars :: APIType -> Set TypeName
typeFreeVars (TyList  APIType
t) = APIType -> Set TypeName
typeFreeVars APIType
t
typeFreeVars (TyMaybe APIType
t) = APIType -> Set TypeName
typeFreeVars APIType
t
typeFreeVars (TyName  TypeName
n) = forall a. a -> Set a
Set.singleton TypeName
n
typeFreeVars (TyBasic BasicType
_) = forall a. Set a
Set.empty
typeFreeVars  APIType
TyJSON     = forall a. Set a
Set.empty


-- | Check if a type is declared in the API
typeDeclaredInApi :: TypeName -> NormAPI -> Bool
typeDeclaredInApi :: TypeName -> NormAPI -> Bool
typeDeclaredInApi TypeName
tname NormAPI
api = forall k a. Ord k => k -> Map k a -> Bool
Map.member TypeName
tname NormAPI
api

-- | Check if a type is used anywhere in the API
typeUsedInApi :: TypeName -> NormAPI -> Bool
typeUsedInApi :: TypeName -> NormAPI -> Bool
typeUsedInApi TypeName
tname NormAPI
api = TypeName
tname forall a. Ord a => a -> Set a -> Bool
`Set.member` NormAPI -> Set TypeName
typeDeclsFreeVars NormAPI
api

-- | Check if the first type's transitive dependencies include the
-- second type
typeUsedInTransitiveDep :: TypeName -> TypeName -> NormAPI -> Bool
typeUsedInTransitiveDep :: TypeName -> TypeName -> NormAPI -> Bool
typeUsedInTransitiveDep TypeName
root TypeName
tname NormAPI
api =
    TypeName
tname forall a. Eq a => a -> a -> Bool
== TypeName
root Bool -> Bool -> Bool
|| TypeName
tname forall a. Ord a => a -> Set a -> Bool
`Set.member` NormAPI -> Set TypeName -> Set TypeName
transitiveDeps NormAPI
api (forall a. a -> Set a
Set.singleton TypeName
root)

-- | Compute the transitive dependencies of a set of types
transitiveDeps :: NormAPI -> Set TypeName -> Set TypeName
transitiveDeps :: NormAPI -> Set TypeName -> Set TypeName
transitiveDeps NormAPI
api = forall a. Ord a => (Set a -> Set a) -> Set a -> Set a
transitiveClosure forall a b. (a -> b) -> a -> b
$ \ Set TypeName
s ->
                         NormAPI -> Set TypeName
typeDeclsFreeVars forall a b. (a -> b) -> a -> b
$
                         forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\ TypeName
x NormTypeDecl
_ -> TypeName
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TypeName
s) NormAPI
api

-- | Compute the set of types that depend (transitively) on the given types
transitiveReverseDeps :: NormAPI -> Set TypeName -> Set TypeName
transitiveReverseDeps :: NormAPI -> Set TypeName -> Set TypeName
transitiveReverseDeps NormAPI
api = forall a. Ord a => (Set a -> Set a) -> Set a -> Set a
transitiveClosure forall a b. (a -> b) -> a -> b
$ \ Set TypeName
s ->
                         forall k a. Map k a -> Set k
Map.keysSet forall a b. (a -> b) -> a -> b
$
                         forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall {a}. Ord a => Set a -> Set a -> Bool
intersects Set TypeName
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormTypeDecl -> Set TypeName
typeDeclFreeVars) NormAPI
api
  where
    intersects :: Set a -> Set a -> Bool
intersects Set a
s1 Set a
s2 = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
Set.null forall a b. (a -> b) -> a -> b
$ Set a
s1 forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set a
s2

-- | Compute the transitive closure of a relation.  Relations are
-- represented as functions that takes a set of elements to the set of
-- related elements.
transitiveClosure :: Ord a => (Set a -> Set a) -> Set a -> Set a
transitiveClosure :: forall a. Ord a => (Set a -> Set a) -> Set a -> Set a
transitiveClosure Set a -> Set a
rel Set a
x = Set a -> Set a -> Set a
findUsed Set a
x0 Set a
x0
  where
    x0 :: Set a
x0 = Set a -> Set a
rel Set a
x

    findUsed :: Set a -> Set a -> Set a
findUsed Set a
seen Set a
old
      | forall a. Set a -> Bool
Set.null Set a
new = Set a
seen
      | Bool
otherwise    = Set a -> Set a -> Set a
findUsed (Set a
seen forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set a
new) Set a
new
      where
        new :: Set a
new = Set a -> Set a
rel Set a
old forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set a
seen


-------------------------
-- Invariant validation
--

-- | Test that all the free type names in a type are declared in the
-- API.  If not, return the set of undeclared types.
typeIsValid :: APIType -> NormAPI -> Either (Set TypeName) ()
typeIsValid :: APIType -> NormAPI -> Either (Set TypeName) ()
typeIsValid APIType
t NormAPI
api
    | Set TypeName
typeVars forall {a}. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set TypeName
declaredTypes = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = forall a b. a -> Either a b
Left (Set TypeName
typeVars forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set TypeName
declaredTypes)
  where
    typeVars :: Set TypeName
typeVars      = APIType -> Set TypeName
typeFreeVars APIType
t
    declaredTypes :: Set TypeName
declaredTypes = forall k a. Map k a -> Set k
Map.keysSet NormAPI
api

-- | Test that all the types used in a type declaration are declared
-- in the API.  If not, return the set of undeclared types.
declIsValid :: NormTypeDecl -> NormAPI -> Either (Set TypeName) ()
declIsValid :: NormTypeDecl -> NormAPI -> Either (Set TypeName) ()
declIsValid NormTypeDecl
decl NormAPI
api
    | Set TypeName
declVars forall {a}. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set TypeName
declaredTypes = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise = forall a b. a -> Either a b
Left (Set TypeName
declVars forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set TypeName
declaredTypes)
  where
    declVars :: Set TypeName
declVars      = NormTypeDecl -> Set TypeName
typeDeclFreeVars NormTypeDecl
decl
    declaredTypes :: Set TypeName
declaredTypes = forall k a. Map k a -> Set k
Map.keysSet NormAPI
api

-- | Test that all the types used in the API are declared.  If not,
-- return the set of undeclared types.
apiInvariant :: NormAPI -> Either (Set TypeName) ()
apiInvariant :: NormAPI -> Either (Set TypeName) ()
apiInvariant NormAPI
api
  | Set TypeName
usedTypes forall {a}. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set TypeName
declaredTypes = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = forall a b. a -> Either a b
Left (Set TypeName
usedTypes forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set TypeName
declaredTypes)
  where
    usedTypes :: Set TypeName
usedTypes     = NormAPI -> Set TypeName
typeDeclsFreeVars NormAPI
api
    declaredTypes :: Set TypeName
declaredTypes = forall k a. Map k a -> Set k
Map.keysSet NormAPI
api


-------------------------
-- Modifying types
--

-- | Substitute types for type names in a declaration
substTypeDecl :: (TypeName -> APIType) -> NormTypeDecl -> NormTypeDecl
substTypeDecl :: (TypeName -> APIType) -> NormTypeDecl -> NormTypeDecl
substTypeDecl TypeName -> APIType
f   (NRecordType NormRecordType
fields) = NormRecordType -> NormTypeDecl
NRecordType (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((TypeName -> APIType) -> APIType -> APIType
substType TypeName -> APIType
f) NormRecordType
fields)
substTypeDecl TypeName -> APIType
f   (NUnionType  NormRecordType
alts)   = NormRecordType -> NormTypeDecl
NUnionType (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((TypeName -> APIType) -> APIType -> APIType
substType TypeName -> APIType
f) NormRecordType
alts)
substTypeDecl TypeName -> APIType
_ d :: NormTypeDecl
d@(NEnumType NormEnumType
_)        = NormTypeDecl
d
substTypeDecl TypeName -> APIType
f   (NTypeSynonym APIType
t)     = APIType -> NormTypeDecl
NTypeSynonym ((TypeName -> APIType) -> APIType -> APIType
substType TypeName -> APIType
f APIType
t)
substTypeDecl TypeName -> APIType
_ d :: NormTypeDecl
d@(NNewtype BasicType
_)         = NormTypeDecl
d

-- | Substitute types for type names in a type
substType :: (TypeName -> APIType) -> APIType -> APIType
substType :: (TypeName -> APIType) -> APIType -> APIType
substType TypeName -> APIType
f (TyList  APIType
t)   = APIType -> APIType
TyList ((TypeName -> APIType) -> APIType -> APIType
substType TypeName -> APIType
f APIType
t)
substType TypeName -> APIType
f (TyMaybe APIType
t)   = APIType -> APIType
TyMaybe ((TypeName -> APIType) -> APIType -> APIType
substType TypeName -> APIType
f APIType
t)
substType TypeName -> APIType
f (TyName  TypeName
n)   = TypeName -> APIType
f TypeName
n
substType TypeName -> APIType
_ t :: APIType
t@(TyBasic BasicType
_) = APIType
t
substType TypeName -> APIType
_ t :: APIType
t@APIType
TyJSON      = APIType
t

-- | Rename the first type to the second throughout the API
renameTypeUses :: TypeName -> TypeName -> NormAPI -> NormAPI
renameTypeUses :: TypeName -> TypeName -> NormAPI -> NormAPI
renameTypeUses TypeName
tname TypeName
tname' = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((TypeName -> APIType) -> NormTypeDecl -> NormTypeDecl
substTypeDecl TypeName -> APIType
rename)
  where
    rename :: TypeName -> APIType
rename TypeName
tn | TypeName
tn forall a. Eq a => a -> a -> Bool
== TypeName
tname = TypeName -> APIType
TyName TypeName
tname'
              | Bool
otherwise   = TypeName -> APIType
TyName TypeName
tn


instance PPLines NormTypeDecl where
  ppLines :: NormTypeDecl -> [String]
ppLines (NRecordType NormRecordType
flds) = String
"record" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\ (FieldName
f, APIType
ty) -> String
"  " forall a. [a] -> [a] -> [a]
++ forall t. PP t => t -> String
pp FieldName
f
                                                            forall a. [a] -> [a] -> [a]
++ String
" :: " forall a. [a] -> [a] -> [a]
++ forall t. PP t => t -> String
pp APIType
ty)
                                              (forall k a. Map k a -> [(k, a)]
Map.toList NormRecordType
flds)
  ppLines (NUnionType NormRecordType
alts)  = String
"union"  forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\ (FieldName
f, APIType
ty) -> String
"  | " forall a. [a] -> [a] -> [a]
++ forall t. PP t => t -> String
pp FieldName
f
                                                            forall a. [a] -> [a] -> [a]
++ String
" :: " forall a. [a] -> [a] -> [a]
++ forall t. PP t => t -> String
pp APIType
ty)
                                              (forall k a. Map k a -> [(k, a)]
Map.toList NormRecordType
alts)
  ppLines (NEnumType NormEnumType
vals)   = String
"enum"   forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\ FieldName
v -> String
"  | " forall a. [a] -> [a] -> [a]
++ forall t. PP t => t -> String
pp FieldName
v)
                                              (forall a. Set a -> [a]
Set.toList NormEnumType
vals)
  ppLines (NTypeSynonym APIType
t)   = [forall t. PP t => t -> String
pp APIType
t]
  ppLines (NNewtype BasicType
b)       = [String
"basic " forall a. [a] -> [a] -> [a]
++ forall t. PP t => t -> String
pp BasicType
b]