{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}

-- |
-- Module                  : Language.Jsonnet.Core
-- Copyright               : (c) 2020-2021 Alexandre Moreno
-- SPDX-License-Identifier : BSD-3-Clause OR Apache-2.0
-- Maintainer              : Alexandre Moreno <alexmorenocano@gmail.com>
-- Stability               : experimental
-- Portability             : non-portable
module Language.Jsonnet.Core where

import Data.Binary (Binary)
import Data.Data (Data)
import Data.String ( IsString(..) )
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Language.Jsonnet.Common ( Args, Prim, Literal, Visibility )
import Language.Jsonnet.Parser.SrcSpan ( SrcSpan )
import Text.Megaparsec.Pos (Pos, SourcePos)
import Unbound.Generics.LocallyNameless
    ( string2Name, Bind, Rec, Embed, Name, Alpha )

type Param a = (Name a, Embed a)

data CField = CField
  { -- |
    CField -> Core
fieldKey :: Core,
    -- |
    CField -> Core
fieldVal :: Core,
    -- |
    CField -> Visibility
fieldVis :: Visibility
  }
  deriving
    ( Int -> CField -> ShowS
[CField] -> ShowS
CField -> String
(Int -> CField -> ShowS)
-> (CField -> String) -> ([CField] -> ShowS) -> Show CField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CField] -> ShowS
$cshowList :: [CField] -> ShowS
show :: CField -> String
$cshow :: CField -> String
showsPrec :: Int -> CField -> ShowS
$cshowsPrec :: Int -> CField -> ShowS
Show,
      (forall x. CField -> Rep CField x)
-> (forall x. Rep CField x -> CField) -> Generic CField
forall x. Rep CField x -> CField
forall x. CField -> Rep CField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CField x -> CField
$cfrom :: forall x. CField -> Rep CField x
Generic,
      Show CField
Show CField
-> (AlphaCtx -> CField -> CField -> Bool)
-> (forall (f :: * -> *).
    (Contravariant f, Applicative f) =>
    AlphaCtx -> (AnyName -> f AnyName) -> CField -> f CField)
-> (AlphaCtx -> NamePatFind -> CField -> CField)
-> (AlphaCtx -> NthPatFind -> CField -> CField)
-> (CField -> DisjointSet AnyName)
-> (CField -> All)
-> (CField -> Bool)
-> (CField -> NthPatFind)
-> (CField -> NamePatFind)
-> (AlphaCtx -> Perm AnyName -> CField -> CField)
-> (forall (m :: * -> *) b.
    LFresh m =>
    AlphaCtx -> CField -> (CField -> Perm AnyName -> m b) -> m b)
-> (forall (m :: * -> *).
    Fresh m =>
    AlphaCtx -> CField -> m (CField, Perm AnyName))
-> (AlphaCtx -> CField -> CField -> Ordering)
-> Alpha CField
AlphaCtx -> NthPatFind -> CField -> CField
AlphaCtx -> NamePatFind -> CField -> CField
AlphaCtx -> Perm AnyName -> CField -> CField
AlphaCtx -> CField -> CField -> Bool
AlphaCtx -> CField -> CField -> Ordering
CField -> Bool
CField -> All
CField -> DisjointSet AnyName
CField -> NthPatFind
CField -> NamePatFind
forall a.
Show a
-> (AlphaCtx -> a -> a -> Bool)
-> (forall (f :: * -> *).
    (Contravariant f, Applicative f) =>
    AlphaCtx -> (AnyName -> f AnyName) -> a -> f a)
-> (AlphaCtx -> NamePatFind -> a -> a)
-> (AlphaCtx -> NthPatFind -> a -> a)
-> (a -> DisjointSet AnyName)
-> (a -> All)
-> (a -> Bool)
-> (a -> NthPatFind)
-> (a -> NamePatFind)
-> (AlphaCtx -> Perm AnyName -> a -> a)
-> (forall (m :: * -> *) b.
    LFresh m =>
    AlphaCtx -> a -> (a -> Perm AnyName -> m b) -> m b)
-> (forall (m :: * -> *).
    Fresh m =>
    AlphaCtx -> a -> m (a, Perm AnyName))
-> (AlphaCtx -> a -> a -> Ordering)
-> Alpha a
forall (f :: * -> *).
(Contravariant f, Applicative f) =>
AlphaCtx -> (AnyName -> f AnyName) -> CField -> f CField
forall (m :: * -> *).
Fresh m =>
AlphaCtx -> CField -> m (CField, Perm AnyName)
forall (m :: * -> *) b.
LFresh m =>
AlphaCtx -> CField -> (CField -> Perm AnyName -> m b) -> m b
acompare' :: AlphaCtx -> CField -> CField -> Ordering
$cacompare' :: AlphaCtx -> CField -> CField -> Ordering
freshen' :: AlphaCtx -> CField -> m (CField, Perm AnyName)
$cfreshen' :: forall (m :: * -> *).
Fresh m =>
AlphaCtx -> CField -> m (CField, Perm AnyName)
lfreshen' :: AlphaCtx -> CField -> (CField -> Perm AnyName -> m b) -> m b
$clfreshen' :: forall (m :: * -> *) b.
LFresh m =>
AlphaCtx -> CField -> (CField -> Perm AnyName -> m b) -> m b
swaps' :: AlphaCtx -> Perm AnyName -> CField -> CField
$cswaps' :: AlphaCtx -> Perm AnyName -> CField -> CField
namePatFind :: CField -> NamePatFind
$cnamePatFind :: CField -> NamePatFind
nthPatFind :: CField -> NthPatFind
$cnthPatFind :: CField -> NthPatFind
isEmbed :: CField -> Bool
$cisEmbed :: CField -> Bool
isTerm :: CField -> All
$cisTerm :: CField -> All
isPat :: CField -> DisjointSet AnyName
$cisPat :: CField -> DisjointSet AnyName
open :: AlphaCtx -> NthPatFind -> CField -> CField
$copen :: AlphaCtx -> NthPatFind -> CField -> CField
close :: AlphaCtx -> NamePatFind -> CField -> CField
$cclose :: AlphaCtx -> NamePatFind -> CField -> CField
fvAny' :: AlphaCtx -> (AnyName -> f AnyName) -> CField -> f CField
$cfvAny' :: forall (f :: * -> *).
(Contravariant f, Applicative f) =>
AlphaCtx -> (AnyName -> f AnyName) -> CField -> f CField
aeq' :: AlphaCtx -> CField -> CField -> Bool
$caeq' :: AlphaCtx -> CField -> CField -> Bool
$cp1Alpha :: Show CField
Alpha,
      Get CField
[CField] -> Put
CField -> Put
(CField -> Put) -> Get CField -> ([CField] -> Put) -> Binary CField
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [CField] -> Put
$cputList :: [CField] -> Put
get :: Get CField
$cget :: Get CField
put :: CField -> Put
$cput :: CField -> Put
Binary
    )

mkField :: Core -> Core -> Visibility -> CField
mkField :: Core -> Core -> Visibility -> CField
mkField = Core -> Core -> Visibility -> CField
CField

instance Binary a => Binary (Name a)

instance Binary a => Binary (Rec a)

instance Binary a => Binary (Embed a)

instance (Binary a, Binary b) => Binary (Bind a b)

data Comp
  = ArrC (Bind (Name Core) (Core, Maybe Core))
  | ObjC (Bind (Name Core) (CField, Maybe Core))
  deriving
    ( Int -> Comp -> ShowS
[Comp] -> ShowS
Comp -> String
(Int -> Comp -> ShowS)
-> (Comp -> String) -> ([Comp] -> ShowS) -> Show Comp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comp] -> ShowS
$cshowList :: [Comp] -> ShowS
show :: Comp -> String
$cshow :: Comp -> String
showsPrec :: Int -> Comp -> ShowS
$cshowsPrec :: Int -> Comp -> ShowS
Show,
      Typeable,
      (forall x. Comp -> Rep Comp x)
-> (forall x. Rep Comp x -> Comp) -> Generic Comp
forall x. Rep Comp x -> Comp
forall x. Comp -> Rep Comp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Comp x -> Comp
$cfrom :: forall x. Comp -> Rep Comp x
Generic,
      Show Comp
Show Comp
-> (AlphaCtx -> Comp -> Comp -> Bool)
-> (forall (f :: * -> *).
    (Contravariant f, Applicative f) =>
    AlphaCtx -> (AnyName -> f AnyName) -> Comp -> f Comp)
-> (AlphaCtx -> NamePatFind -> Comp -> Comp)
-> (AlphaCtx -> NthPatFind -> Comp -> Comp)
-> (Comp -> DisjointSet AnyName)
-> (Comp -> All)
-> (Comp -> Bool)
-> (Comp -> NthPatFind)
-> (Comp -> NamePatFind)
-> (AlphaCtx -> Perm AnyName -> Comp -> Comp)
-> (forall (m :: * -> *) b.
    LFresh m =>
    AlphaCtx -> Comp -> (Comp -> Perm AnyName -> m b) -> m b)
-> (forall (m :: * -> *).
    Fresh m =>
    AlphaCtx -> Comp -> m (Comp, Perm AnyName))
-> (AlphaCtx -> Comp -> Comp -> Ordering)
-> Alpha Comp
AlphaCtx -> NthPatFind -> Comp -> Comp
AlphaCtx -> NamePatFind -> Comp -> Comp
AlphaCtx -> Perm AnyName -> Comp -> Comp
AlphaCtx -> Comp -> Comp -> Bool
AlphaCtx -> Comp -> Comp -> Ordering
Comp -> Bool
Comp -> All
Comp -> DisjointSet AnyName
Comp -> NthPatFind
Comp -> NamePatFind
forall a.
Show a
-> (AlphaCtx -> a -> a -> Bool)
-> (forall (f :: * -> *).
    (Contravariant f, Applicative f) =>
    AlphaCtx -> (AnyName -> f AnyName) -> a -> f a)
-> (AlphaCtx -> NamePatFind -> a -> a)
-> (AlphaCtx -> NthPatFind -> a -> a)
-> (a -> DisjointSet AnyName)
-> (a -> All)
-> (a -> Bool)
-> (a -> NthPatFind)
-> (a -> NamePatFind)
-> (AlphaCtx -> Perm AnyName -> a -> a)
-> (forall (m :: * -> *) b.
    LFresh m =>
    AlphaCtx -> a -> (a -> Perm AnyName -> m b) -> m b)
-> (forall (m :: * -> *).
    Fresh m =>
    AlphaCtx -> a -> m (a, Perm AnyName))
-> (AlphaCtx -> a -> a -> Ordering)
-> Alpha a
forall (f :: * -> *).
(Contravariant f, Applicative f) =>
AlphaCtx -> (AnyName -> f AnyName) -> Comp -> f Comp
forall (m :: * -> *).
Fresh m =>
AlphaCtx -> Comp -> m (Comp, Perm AnyName)
forall (m :: * -> *) b.
LFresh m =>
AlphaCtx -> Comp -> (Comp -> Perm AnyName -> m b) -> m b
acompare' :: AlphaCtx -> Comp -> Comp -> Ordering
$cacompare' :: AlphaCtx -> Comp -> Comp -> Ordering
freshen' :: AlphaCtx -> Comp -> m (Comp, Perm AnyName)
$cfreshen' :: forall (m :: * -> *).
Fresh m =>
AlphaCtx -> Comp -> m (Comp, Perm AnyName)
lfreshen' :: AlphaCtx -> Comp -> (Comp -> Perm AnyName -> m b) -> m b
$clfreshen' :: forall (m :: * -> *) b.
LFresh m =>
AlphaCtx -> Comp -> (Comp -> Perm AnyName -> m b) -> m b
swaps' :: AlphaCtx -> Perm AnyName -> Comp -> Comp
$cswaps' :: AlphaCtx -> Perm AnyName -> Comp -> Comp
namePatFind :: Comp -> NamePatFind
$cnamePatFind :: Comp -> NamePatFind
nthPatFind :: Comp -> NthPatFind
$cnthPatFind :: Comp -> NthPatFind
isEmbed :: Comp -> Bool
$cisEmbed :: Comp -> Bool
isTerm :: Comp -> All
$cisTerm :: Comp -> All
isPat :: Comp -> DisjointSet AnyName
$cisPat :: Comp -> DisjointSet AnyName
open :: AlphaCtx -> NthPatFind -> Comp -> Comp
$copen :: AlphaCtx -> NthPatFind -> Comp -> Comp
close :: AlphaCtx -> NamePatFind -> Comp -> Comp
$cclose :: AlphaCtx -> NamePatFind -> Comp -> Comp
fvAny' :: AlphaCtx -> (AnyName -> f AnyName) -> Comp -> f Comp
$cfvAny' :: forall (f :: * -> *).
(Contravariant f, Applicative f) =>
AlphaCtx -> (AnyName -> f AnyName) -> Comp -> f Comp
aeq' :: AlphaCtx -> Comp -> Comp -> Bool
$caeq' :: AlphaCtx -> Comp -> Comp -> Bool
$cp1Alpha :: Show Comp
Alpha,
      Get Comp
[Comp] -> Put
Comp -> Put
(Comp -> Put) -> Get Comp -> ([Comp] -> Put) -> Binary Comp
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Comp] -> Put
$cputList :: [Comp] -> Put
get :: Get Comp
$cget :: Get Comp
put :: Comp -> Put
$cput :: Comp -> Put
Binary
    )

type Lam = Bind (Rec [Param Core]) Core

type Let = Bind (Rec [(Name Core, Embed Core)]) Core

data Core where
  CLoc :: SrcSpan -> Core -> Core
  CLit :: Literal -> Core
  CVar :: Name Core -> Core
  CLam :: Lam -> Core
  CPrim :: Prim -> Core
  CApp :: Core -> Args Core -> Core
  CLet :: Let -> Core
  CObj :: [CField] -> Core
  CArr :: [Core] -> Core
  CComp :: Comp -> Core -> Core
  deriving
    ( Int -> Core -> ShowS
[Core] -> ShowS
Core -> String
(Int -> Core -> ShowS)
-> (Core -> String) -> ([Core] -> ShowS) -> Show Core
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Core] -> ShowS
$cshowList :: [Core] -> ShowS
show :: Core -> String
$cshow :: Core -> String
showsPrec :: Int -> Core -> ShowS
$cshowsPrec :: Int -> Core -> ShowS
Show,
      Typeable,
      (forall x. Core -> Rep Core x)
-> (forall x. Rep Core x -> Core) -> Generic Core
forall x. Rep Core x -> Core
forall x. Core -> Rep Core x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Core x -> Core
$cfrom :: forall x. Core -> Rep Core x
Generic,
      Show Core
Show Core
-> (AlphaCtx -> Core -> Core -> Bool)
-> (forall (f :: * -> *).
    (Contravariant f, Applicative f) =>
    AlphaCtx -> (AnyName -> f AnyName) -> Core -> f Core)
-> (AlphaCtx -> NamePatFind -> Core -> Core)
-> (AlphaCtx -> NthPatFind -> Core -> Core)
-> (Core -> DisjointSet AnyName)
-> (Core -> All)
-> (Core -> Bool)
-> (Core -> NthPatFind)
-> (Core -> NamePatFind)
-> (AlphaCtx -> Perm AnyName -> Core -> Core)
-> (forall (m :: * -> *) b.
    LFresh m =>
    AlphaCtx -> Core -> (Core -> Perm AnyName -> m b) -> m b)
-> (forall (m :: * -> *).
    Fresh m =>
    AlphaCtx -> Core -> m (Core, Perm AnyName))
-> (AlphaCtx -> Core -> Core -> Ordering)
-> Alpha Core
AlphaCtx -> NthPatFind -> Core -> Core
AlphaCtx -> NamePatFind -> Core -> Core
AlphaCtx -> Perm AnyName -> Core -> Core
AlphaCtx -> Core -> Core -> Bool
AlphaCtx -> Core -> Core -> Ordering
Core -> Bool
Core -> All
Core -> DisjointSet AnyName
Core -> NthPatFind
Core -> NamePatFind
forall a.
Show a
-> (AlphaCtx -> a -> a -> Bool)
-> (forall (f :: * -> *).
    (Contravariant f, Applicative f) =>
    AlphaCtx -> (AnyName -> f AnyName) -> a -> f a)
-> (AlphaCtx -> NamePatFind -> a -> a)
-> (AlphaCtx -> NthPatFind -> a -> a)
-> (a -> DisjointSet AnyName)
-> (a -> All)
-> (a -> Bool)
-> (a -> NthPatFind)
-> (a -> NamePatFind)
-> (AlphaCtx -> Perm AnyName -> a -> a)
-> (forall (m :: * -> *) b.
    LFresh m =>
    AlphaCtx -> a -> (a -> Perm AnyName -> m b) -> m b)
-> (forall (m :: * -> *).
    Fresh m =>
    AlphaCtx -> a -> m (a, Perm AnyName))
-> (AlphaCtx -> a -> a -> Ordering)
-> Alpha a
forall (f :: * -> *).
(Contravariant f, Applicative f) =>
AlphaCtx -> (AnyName -> f AnyName) -> Core -> f Core
forall (m :: * -> *).
Fresh m =>
AlphaCtx -> Core -> m (Core, Perm AnyName)
forall (m :: * -> *) b.
LFresh m =>
AlphaCtx -> Core -> (Core -> Perm AnyName -> m b) -> m b
acompare' :: AlphaCtx -> Core -> Core -> Ordering
$cacompare' :: AlphaCtx -> Core -> Core -> Ordering
freshen' :: AlphaCtx -> Core -> m (Core, Perm AnyName)
$cfreshen' :: forall (m :: * -> *).
Fresh m =>
AlphaCtx -> Core -> m (Core, Perm AnyName)
lfreshen' :: AlphaCtx -> Core -> (Core -> Perm AnyName -> m b) -> m b
$clfreshen' :: forall (m :: * -> *) b.
LFresh m =>
AlphaCtx -> Core -> (Core -> Perm AnyName -> m b) -> m b
swaps' :: AlphaCtx -> Perm AnyName -> Core -> Core
$cswaps' :: AlphaCtx -> Perm AnyName -> Core -> Core
namePatFind :: Core -> NamePatFind
$cnamePatFind :: Core -> NamePatFind
nthPatFind :: Core -> NthPatFind
$cnthPatFind :: Core -> NthPatFind
isEmbed :: Core -> Bool
$cisEmbed :: Core -> Bool
isTerm :: Core -> All
$cisTerm :: Core -> All
isPat :: Core -> DisjointSet AnyName
$cisPat :: Core -> DisjointSet AnyName
open :: AlphaCtx -> NthPatFind -> Core -> Core
$copen :: AlphaCtx -> NthPatFind -> Core -> Core
close :: AlphaCtx -> NamePatFind -> Core -> Core
$cclose :: AlphaCtx -> NamePatFind -> Core -> Core
fvAny' :: AlphaCtx -> (AnyName -> f AnyName) -> Core -> f Core
$cfvAny' :: forall (f :: * -> *).
(Contravariant f, Applicative f) =>
AlphaCtx -> (AnyName -> f AnyName) -> Core -> f Core
aeq' :: AlphaCtx -> Core -> Core -> Bool
$caeq' :: AlphaCtx -> Core -> Core -> Bool
$cp1Alpha :: Show Core
Alpha,
      Get Core
[Core] -> Put
Core -> Put
(Core -> Put) -> Get Core -> ([Core] -> Put) -> Binary Core
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Core] -> Put
$cputList :: [Core] -> Put
get :: Get Core
$cget :: Get Core
put :: Core -> Put
$cput :: Core -> Put
Binary
    )

--data Params
--  = EmptyPs
--  | ConsPs (Rebind (Name Core, Embed (Maybe Core)) Params)
--  deriving (Show, Typeable, Generic)
--instance Alpha Params

instance IsString (Name Core) where
  fromString :: String -> Name Core
fromString = String -> Name Core
forall a. String -> Name a
string2Name