{- |
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
-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}

module Language.Jsonnet.Core where

import Data.Data (Data)
import Data.String
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Language.Jsonnet.Common
import Language.Jsonnet.Parser.SrcSpan
import Unbound.Generics.LocallyNameless

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)

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

--pattern CField k v h <- CField_ k _ v h

instance Alpha CField

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)

instance Alpha Comp

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)

instance Alpha Core

--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