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

module Language.REST.RuntimeTerm
  ( RuntimeTerm(..)
  , ToRuntimeTerm(..)
  , subTerms
  , contains
  )
where

import           Data.Hashable
import           GHC.Generics (Generic)
import           Text.Printf
import qualified Data.List as L

import           Language.REST.Op

-- | Ground terms
data RuntimeTerm = App Op [RuntimeTerm] deriving (RuntimeTerm -> RuntimeTerm -> Bool
(RuntimeTerm -> RuntimeTerm -> Bool)
-> (RuntimeTerm -> RuntimeTerm -> Bool) -> Eq RuntimeTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuntimeTerm -> RuntimeTerm -> Bool
== :: RuntimeTerm -> RuntimeTerm -> Bool
$c/= :: RuntimeTerm -> RuntimeTerm -> Bool
/= :: RuntimeTerm -> RuntimeTerm -> Bool
Eq, Eq RuntimeTerm
Eq RuntimeTerm =>
(RuntimeTerm -> RuntimeTerm -> Ordering)
-> (RuntimeTerm -> RuntimeTerm -> Bool)
-> (RuntimeTerm -> RuntimeTerm -> Bool)
-> (RuntimeTerm -> RuntimeTerm -> Bool)
-> (RuntimeTerm -> RuntimeTerm -> Bool)
-> (RuntimeTerm -> RuntimeTerm -> RuntimeTerm)
-> (RuntimeTerm -> RuntimeTerm -> RuntimeTerm)
-> Ord RuntimeTerm
RuntimeTerm -> RuntimeTerm -> Bool
RuntimeTerm -> RuntimeTerm -> Ordering
RuntimeTerm -> RuntimeTerm -> RuntimeTerm
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
$ccompare :: RuntimeTerm -> RuntimeTerm -> Ordering
compare :: RuntimeTerm -> RuntimeTerm -> Ordering
$c< :: RuntimeTerm -> RuntimeTerm -> Bool
< :: RuntimeTerm -> RuntimeTerm -> Bool
$c<= :: RuntimeTerm -> RuntimeTerm -> Bool
<= :: RuntimeTerm -> RuntimeTerm -> Bool
$c> :: RuntimeTerm -> RuntimeTerm -> Bool
> :: RuntimeTerm -> RuntimeTerm -> Bool
$c>= :: RuntimeTerm -> RuntimeTerm -> Bool
>= :: RuntimeTerm -> RuntimeTerm -> Bool
$cmax :: RuntimeTerm -> RuntimeTerm -> RuntimeTerm
max :: RuntimeTerm -> RuntimeTerm -> RuntimeTerm
$cmin :: RuntimeTerm -> RuntimeTerm -> RuntimeTerm
min :: RuntimeTerm -> RuntimeTerm -> RuntimeTerm
Ord, (forall x. RuntimeTerm -> Rep RuntimeTerm x)
-> (forall x. Rep RuntimeTerm x -> RuntimeTerm)
-> Generic RuntimeTerm
forall x. Rep RuntimeTerm x -> RuntimeTerm
forall x. RuntimeTerm -> Rep RuntimeTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RuntimeTerm -> Rep RuntimeTerm x
from :: forall x. RuntimeTerm -> Rep RuntimeTerm x
$cto :: forall x. Rep RuntimeTerm x -> RuntimeTerm
to :: forall x. Rep RuntimeTerm x -> RuntimeTerm
Generic, Eq RuntimeTerm
Eq RuntimeTerm =>
(Int -> RuntimeTerm -> Int)
-> (RuntimeTerm -> Int) -> Hashable RuntimeTerm
Int -> RuntimeTerm -> Int
RuntimeTerm -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> RuntimeTerm -> Int
hashWithSalt :: Int -> RuntimeTerm -> Int
$chash :: RuntimeTerm -> Int
hash :: RuntimeTerm -> Int
Hashable)

instance Show RuntimeTerm where
  show :: RuntimeTerm -> String
show (App Op
op []) = Op -> String
forall a. Show a => a -> String
show Op
op
  show (App Op
op [RuntimeTerm]
ts) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%s(%s)" (Op -> String
forall a. Show a => a -> String
show Op
op) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " ((RuntimeTerm -> String) -> [RuntimeTerm] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map RuntimeTerm -> String
forall a. Show a => a -> String
show [RuntimeTerm]
ts)

-- | Transformable to a ground term
class ToRuntimeTerm a where
  toRuntimeTerm :: a -> RuntimeTerm

instance ToRuntimeTerm Op where
  toRuntimeTerm :: Op -> RuntimeTerm
toRuntimeTerm Op
op = Op -> [RuntimeTerm] -> RuntimeTerm
App Op
op []

instance ToRuntimeTerm RuntimeTerm where
  toRuntimeTerm :: RuntimeTerm -> RuntimeTerm
toRuntimeTerm = RuntimeTerm -> RuntimeTerm
forall a. a -> a
id

-- | @subTerms t@ returns a list of pairs @(s, f)@, where @s@ is a subterm of @t@,
-- and @f@ is a function that takes a replacement @s'@ for @s@, and generates a new
-- term where @s@ is replaced with @s'@ in @t@. Also includes the pair (t, id),
-- representing the term itself.
-- TODO: Consider more efficient implementations
subTerms :: RuntimeTerm -> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
subTerms :: RuntimeTerm -> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
subTerms t :: RuntimeTerm
t@(App Op
f [RuntimeTerm]
ts) = (RuntimeTerm
t, RuntimeTerm -> RuntimeTerm
forall a. a -> a
id) (RuntimeTerm, RuntimeTerm -> RuntimeTerm)
-> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
-> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
forall a. a -> [a] -> [a]
: (Int -> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)])
-> [Int] -> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
st [Int
0..[RuntimeTerm] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [RuntimeTerm]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  where
    st :: Int -> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
    st :: Int -> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
st Int
i =
      let
        ti :: RuntimeTerm
ti = [RuntimeTerm]
ts [RuntimeTerm] -> Int -> RuntimeTerm
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
        go :: RuntimeTerm -> RuntimeTerm
go RuntimeTerm
t' =
          Op -> [RuntimeTerm] -> RuntimeTerm
App Op
f ([RuntimeTerm] -> RuntimeTerm) -> [RuntimeTerm] -> RuntimeTerm
forall a b. (a -> b) -> a -> b
$ Int -> [RuntimeTerm] -> [RuntimeTerm]
forall a. Int -> [a] -> [a]
take Int
i [RuntimeTerm]
ts [RuntimeTerm] -> [RuntimeTerm] -> [RuntimeTerm]
forall a. [a] -> [a] -> [a]
++ [RuntimeTerm
t'] [RuntimeTerm] -> [RuntimeTerm] -> [RuntimeTerm]
forall a. [a] -> [a] -> [a]
++ Int -> [RuntimeTerm] -> [RuntimeTerm]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [RuntimeTerm]
ts
        go2 :: (a, a -> RuntimeTerm) -> (a, a -> RuntimeTerm)
go2 (a
srt, a -> RuntimeTerm
toFull) = (a
srt, RuntimeTerm -> RuntimeTerm
go (RuntimeTerm -> RuntimeTerm)
-> (a -> RuntimeTerm) -> a -> RuntimeTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RuntimeTerm
toFull)
      in
        ((RuntimeTerm, RuntimeTerm -> RuntimeTerm)
 -> (RuntimeTerm, RuntimeTerm -> RuntimeTerm))
-> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
-> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
forall a b. (a -> b) -> [a] -> [b]
map (RuntimeTerm, RuntimeTerm -> RuntimeTerm)
-> (RuntimeTerm, RuntimeTerm -> RuntimeTerm)
forall {a} {a}. (a, a -> RuntimeTerm) -> (a, a -> RuntimeTerm)
go2 (RuntimeTerm -> [(RuntimeTerm, RuntimeTerm -> RuntimeTerm)]
subTerms RuntimeTerm
ti)


-- | @t `contains` u@ iff @t == u@ or @u@ is a subterm of @t@
contains :: RuntimeTerm -> RuntimeTerm -> Bool
contains :: RuntimeTerm -> RuntimeTerm -> Bool
contains RuntimeTerm
t1 RuntimeTerm
t2 | RuntimeTerm
t1 RuntimeTerm -> RuntimeTerm -> Bool
forall a. Eq a => a -> a -> Bool
== RuntimeTerm
t2 = Bool
True
contains (App Op
_ [RuntimeTerm]
ts) RuntimeTerm
t     = (RuntimeTerm -> Bool) -> [RuntimeTerm] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (RuntimeTerm -> RuntimeTerm -> Bool
contains RuntimeTerm
t) [RuntimeTerm]
ts