-- |
-- Module      :  Logical.OrdConstraints
-- Copyright   :  (c) Oleksandr Zhabenko 2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Some simple logical encoding 'syntactical sugar' to represent point-wise or intervals-based logics.

module Logical.OrdConstraints where

import Data.Foldable
import Data.Maybe

-- | Data type to encode the simple logical contstraints for some 'Ord'ered data type value to be kept in some bounds (to lay in some intervals or points). 'O' constructor  encodes
-- point-wise logics, and 'C' encodes intervals logics.
data OrdConstraints a = O [a] | C [a] deriving (Eq, Ord, Show, Read)

type OrdCs t a = t (OrdConstraints a)

-- | The predicate to check whether the data is  encoded logically correct just enough to be used by the functions in the library (minimal necessary validation). Checks whether 
-- at least just one point or interval is set.
validOrdCs :: Ord a =>  OrdConstraints a -> Bool
validOrdCs (O (_:_)) = True
validOrdCs (C xs@(_:_:_)) = (length xs `rem` 2) == 0
validOrdCs _ = False

ordCs2Predicate1 :: Ord a => OrdConstraints a -> a -> Bool
ordCs2Predicate1 x@(O xs) y
 | validOrdCs x = any (== y) xs
 | otherwise = False
ordCs2Predicate1 x@(C xs) y
 | validOrdCs x = any (\(t:u:_) -> y >= t && y <= u) . f $ xs
 | otherwise = False
    where f (x:y:xs) = [x,y]:f xs
          f _ = []

ordCs2HPred1 :: (Ord a, Foldable t1) => OrdCs t1 a -> a -> Bool
ordCs2HPred1 cs y = any (\c -> ordCs2Predicate1 c y) $ cs

-- | Just the head of the list is used. Therefore, is intended to be used mainly with the singleton list as the second argument.
ordCs2Predicate :: Ord a => OrdConstraints a -> [a] -> Bool
ordCs2Predicate x ys
 | null ys = False
 | otherwise = ordCs2Predicate1 x (head ys)
{-# INLINE ordCs2Predicate #-}

-- | Just the head of the list is used. Therefore, is intended to be used mainly with the singleton list as the second argument.
ordCs2HPred :: (Ord a, Foldable t1) => OrdCs t1 a -> [a] -> Bool
ordCs2HPred cs ys 
 | null ys = False
 | otherwise = any (\c -> ordCs2Predicate1 c (head ys)) $ cs

ordCs2PredicateG :: (Ord a, Foldable t) => OrdConstraints a -> (t a -> Maybe a) -> t a -> Bool
ordCs2PredicateG x@(O xs) p ys
 | validOrdCs x = any (\k -> (fromMaybe False . fmap (== k) . p $ ys)) xs
 | otherwise = False
ordCs2PredicateG x@(C xs) p ys
 | validOrdCs x = any (\(t:u:_) -> fromMaybe False . fmap (\k -> k >= t && k <= u) . p $ ys) . f $ xs
 | otherwise = False
    where f (x:y:xs) = [x,y]:f xs
          f _ = []

ordCs2HPredG :: (Ord a, Foldable t, Foldable t1) => OrdCs t1 a -> (t a -> Maybe a) -> t a -> Bool
ordCs2HPredG cs p ys = any (\c -> ordCs2PredicateG c p ys) $ cs