{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

module Language.REST.MetaTerm where

import Data.String
import Data.Hashable
import GHC.Generics (Generic)
import qualified Data.Set as S

import Language.REST.Op
import Language.REST.RuntimeTerm

data MetaTerm =
    Var String
  | RWApp Op [MetaTerm] deriving (MetaTerm -> MetaTerm -> Bool
(MetaTerm -> MetaTerm -> Bool)
-> (MetaTerm -> MetaTerm -> Bool) -> Eq MetaTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaTerm -> MetaTerm -> Bool
$c/= :: MetaTerm -> MetaTerm -> Bool
== :: MetaTerm -> MetaTerm -> Bool
$c== :: MetaTerm -> MetaTerm -> Bool
Eq, Eq MetaTerm
Eq MetaTerm
-> (MetaTerm -> MetaTerm -> Ordering)
-> (MetaTerm -> MetaTerm -> Bool)
-> (MetaTerm -> MetaTerm -> Bool)
-> (MetaTerm -> MetaTerm -> Bool)
-> (MetaTerm -> MetaTerm -> Bool)
-> (MetaTerm -> MetaTerm -> MetaTerm)
-> (MetaTerm -> MetaTerm -> MetaTerm)
-> Ord MetaTerm
MetaTerm -> MetaTerm -> Bool
MetaTerm -> MetaTerm -> Ordering
MetaTerm -> MetaTerm -> MetaTerm
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 :: MetaTerm -> MetaTerm -> MetaTerm
$cmin :: MetaTerm -> MetaTerm -> MetaTerm
max :: MetaTerm -> MetaTerm -> MetaTerm
$cmax :: MetaTerm -> MetaTerm -> MetaTerm
>= :: MetaTerm -> MetaTerm -> Bool
$c>= :: MetaTerm -> MetaTerm -> Bool
> :: MetaTerm -> MetaTerm -> Bool
$c> :: MetaTerm -> MetaTerm -> Bool
<= :: MetaTerm -> MetaTerm -> Bool
$c<= :: MetaTerm -> MetaTerm -> Bool
< :: MetaTerm -> MetaTerm -> Bool
$c< :: MetaTerm -> MetaTerm -> Bool
compare :: MetaTerm -> MetaTerm -> Ordering
$ccompare :: MetaTerm -> MetaTerm -> Ordering
$cp1Ord :: Eq MetaTerm
Ord, Int -> MetaTerm -> ShowS
[MetaTerm] -> ShowS
MetaTerm -> String
(Int -> MetaTerm -> ShowS)
-> (MetaTerm -> String) -> ([MetaTerm] -> ShowS) -> Show MetaTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaTerm] -> ShowS
$cshowList :: [MetaTerm] -> ShowS
show :: MetaTerm -> String
$cshow :: MetaTerm -> String
showsPrec :: Int -> MetaTerm -> ShowS
$cshowsPrec :: Int -> MetaTerm -> ShowS
Show, (forall x. MetaTerm -> Rep MetaTerm x)
-> (forall x. Rep MetaTerm x -> MetaTerm) -> Generic MetaTerm
forall x. Rep MetaTerm x -> MetaTerm
forall x. MetaTerm -> Rep MetaTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetaTerm x -> MetaTerm
$cfrom :: forall x. MetaTerm -> Rep MetaTerm x
Generic, Int -> MetaTerm -> Int
MetaTerm -> Int
(Int -> MetaTerm -> Int) -> (MetaTerm -> Int) -> Hashable MetaTerm
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MetaTerm -> Int
$chash :: MetaTerm -> Int
hashWithSalt :: Int -> MetaTerm -> Int
$chashWithSalt :: Int -> MetaTerm -> Int
Hashable)

instance IsString MetaTerm where
  fromString :: String -> MetaTerm
fromString = String -> MetaTerm
Var

class ToMetaTerm a where
  toMetaTerm :: a -> MetaTerm

instance ToMetaTerm MetaTerm where
  toMetaTerm :: MetaTerm -> MetaTerm
toMetaTerm = MetaTerm -> MetaTerm
forall a. a -> a
id

instance ToMetaTerm RuntimeTerm where
  toMetaTerm :: RuntimeTerm -> MetaTerm
toMetaTerm (App Op
f [RuntimeTerm]
xs) = Op -> [MetaTerm] -> MetaTerm
RWApp Op
f ((RuntimeTerm -> MetaTerm) -> [RuntimeTerm] -> [MetaTerm]
forall a b. (a -> b) -> [a] -> [b]
map RuntimeTerm -> MetaTerm
forall a. ToMetaTerm a => a -> MetaTerm
toMetaTerm [RuntimeTerm]
xs)

termOps :: ToMetaTerm a => a -> S.Set Op
termOps :: a -> Set Op
termOps = MetaTerm -> Set Op
go (MetaTerm -> Set Op) -> (a -> MetaTerm) -> a -> Set Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MetaTerm
forall a. ToMetaTerm a => a -> MetaTerm
toMetaTerm where
  go :: MetaTerm -> S.Set Op
  go :: MetaTerm -> Set Op
go (Var String
_)         = Set Op
forall a. Set a
S.empty
  go (RWApp Op
op [MetaTerm]
trms) = Op -> Set Op -> Set Op
forall a. Ord a => a -> Set a -> Set a
S.insert Op
op ([Set Op] -> Set Op
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((MetaTerm -> Set Op) -> [MetaTerm] -> [Set Op]
forall a b. (a -> b) -> [a] -> [b]
map MetaTerm -> Set Op
go [MetaTerm]
trms))