{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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 (Maybe a))

data KeyValue a = KeyValue a (Hideable a)
  deriving (Int -> KeyValue a -> ShowS
[KeyValue a] -> ShowS
KeyValue a -> String
(Int -> KeyValue a -> ShowS)
-> (KeyValue a -> String)
-> ([KeyValue a] -> ShowS)
-> Show (KeyValue a)
forall a. Show a => Int -> KeyValue a -> ShowS
forall a. Show a => [KeyValue a] -> ShowS
forall a. Show a => KeyValue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyValue a] -> ShowS
$cshowList :: forall a. Show a => [KeyValue a] -> ShowS
show :: KeyValue a -> String
$cshow :: forall a. Show a => KeyValue a -> String
showsPrec :: Int -> KeyValue a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> KeyValue a -> ShowS
Show, Typeable, (forall x. KeyValue a -> Rep (KeyValue a) x)
-> (forall x. Rep (KeyValue a) x -> KeyValue a)
-> Generic (KeyValue a)
forall x. Rep (KeyValue a) x -> KeyValue a
forall x. KeyValue a -> Rep (KeyValue a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (KeyValue a) x -> KeyValue a
forall a x. KeyValue a -> Rep (KeyValue a) x
$cto :: forall a x. Rep (KeyValue a) x -> KeyValue a
$cfrom :: forall a x. KeyValue a -> Rep (KeyValue a) x
Generic)

instance Alpha a => Alpha (KeyValue a)

newtype Fun = Fun (Bind (Rec [Param Core]) Core)
  deriving (Int -> Fun -> ShowS
[Fun] -> ShowS
Fun -> String
(Int -> Fun -> ShowS)
-> (Fun -> String) -> ([Fun] -> ShowS) -> Show Fun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fun] -> ShowS
$cshowList :: [Fun] -> ShowS
show :: Fun -> String
$cshow :: Fun -> String
showsPrec :: Int -> Fun -> ShowS
$cshowsPrec :: Int -> Fun -> ShowS
Show, Typeable, (forall x. Fun -> Rep Fun x)
-> (forall x. Rep Fun x -> Fun) -> Generic Fun
forall x. Rep Fun x -> Fun
forall x. Fun -> Rep Fun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fun x -> Fun
$cfrom :: forall x. Fun -> Rep Fun x
Generic)

instance Alpha Fun

newtype Let
  = Let (Bind (Rec [(Name Core, Embed Core)]) Core)
  deriving (Int -> Let -> ShowS
[Let] -> ShowS
Let -> String
(Int -> Let -> ShowS)
-> (Let -> String) -> ([Let] -> ShowS) -> Show Let
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Let] -> ShowS
$cshowList :: [Let] -> ShowS
show :: Let -> String
$cshow :: Let -> String
showsPrec :: Int -> Let -> ShowS
$cshowsPrec :: Int -> Let -> ShowS
Show, Typeable, (forall x. Let -> Rep Let x)
-> (forall x. Rep Let x -> Let) -> Generic Let
forall x. Rep Let x -> Let
forall x. Let -> Rep Let x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Let x -> Let
$cfrom :: forall x. Let -> Rep Let x
Generic)

instance Alpha Let

data Comp
  = ArrC (Bind (Name Core) (Core, Maybe Core))
  | ObjC (Bind (Name Core) (KeyValue Core, 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

data Core
  = CLoc SrcSpan Core
  | CLit Literal
  | CVar (Name Core)
  | CFun Fun
  | CApp Core (Args Core)
  | CLet Let
  | CObj [KeyValue Core]
  | CArr [Core]
  | CBinOp BinOp Core Core
  | CUnyOp UnyOp Core
  | CIfElse Core Core Core
  | CErr Core
  | CLookup Core Core
  | CComp Comp 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