{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Core REST functions
module Language.REST.Core where

import           Language.REST.OCAlgebra
import           Language.REST.RuntimeTerm

-- | @orient impl ts@ generates the constraints on an ordering defined by the
--   OCA `impl`, that ensures each term in the path `ts` is smaller than or
--   equal to the previous one.
orient :: OCAlgebra oc RuntimeTerm m -> [RuntimeTerm] -> oc
orient :: forall oc (m :: * -> *).
OCAlgebra oc RuntimeTerm m -> [RuntimeTerm] -> oc
orient OCAlgebra oc RuntimeTerm m
impl [RuntimeTerm]
ts0 = oc -> [(RuntimeTerm, RuntimeTerm)] -> oc
go (forall c a (m :: * -> *). OCAlgebra c a m -> c
top OCAlgebra oc RuntimeTerm m
impl) (forall a b. [a] -> [b] -> [(a, b)]
zip [RuntimeTerm]
ts0 (forall a. [a] -> [a]
tail [RuntimeTerm]
ts0))
   where
    go :: oc -> [(RuntimeTerm, RuntimeTerm)] -> oc
go oc
oc []            = oc
oc
    go oc
oc ((RuntimeTerm
t0, RuntimeTerm
t1):[(RuntimeTerm, RuntimeTerm)]
ts) = oc -> [(RuntimeTerm, RuntimeTerm)] -> oc
go (forall c a (m :: * -> *). OCAlgebra c a m -> c -> a -> a -> c
refine OCAlgebra oc RuntimeTerm m
impl oc
oc RuntimeTerm
t0 RuntimeTerm
t1) [(RuntimeTerm, RuntimeTerm)]
ts