T1089.hs

{-@ LIQUID "--exact-data-con"                      @-}
{-@ LIQUID "--higherorder"                         @-}
{-@ LIQUID "--no-termination"                      @-}
{-@ LIQUID "--automatic-instances=liquidinstances" @-}

{-# LANGUAGE ExistentialQuantification, KindSignatures, TypeFamilies, GADTs #-}

module Query where

import Prelude hiding (filter)

data PersistFilter = EQUAL | LE | GE

-- class PersistEntity record where
    {- data EntityField @-}
    -- data EntityField record :: * -> *

{- data Filter record typ = Filter { filterField :: EntityField record typ, filterValue :: typ, filterFilter :: PersistFilter } @-}
data Filter typ = Filter
  { filterField  :: EntityField typ
  , filterValue  :: typ
  , filterFilter :: PersistFilter
  }

createEqQuery :: EntityField typ -> typ -> Filter typ
createEqQuery field value = Filter
  { filterField  = field
  , filterValue  = value
  , filterFilter = EQUAL
  }

data Blob  = B { xVal :: Int, yVal :: Int }

--instance PersistEntity Blob where
    {- data EntityField record typ where
        BlobXVal :: EntityField Blob Int
      | BlobYVal :: EntityField Blob Int
    @-}
data EntityField typ where
   BlobXVal :: EntityField Int
   BlobYVal :: EntityField Int

{-@ filter :: f:(a -> Bool) -> [a] -> [{v:a | f v}] @-}
filter :: (a -> Bool) -> [a] -> [a]
filter f (x:xs)
  | f x         = x : filter f xs
  | otherwise   =     filter f xs
filter _ []     = []


{-@ reflect evalQBlobXVal @-}
evalQBlobXVal :: Int -> Int -> Bool
evalQBlobXVal filter given = filter == given

{-@ reflect evalQBlobYVal @-}
evalQBlobYVal :: Int -> Int -> Bool
evalQBlobYVal filter given = filter == given

{-@ reflect evalQBlob @-}
evalQBlob :: Filter typ -> Blob -> Bool
evalQBlob filter blob = case filterField filter of
    BlobXVal -> evalQBlobXVal (filterValue filter) (xVal blob)
    BlobYVal -> evalQBlobYVal (filterValue filter) (yVal blob)

{-@ filterQBlob :: f:(Filter a) -> [Blob] -> [{b:Blob | evalQBlob f b}] @-}
filterQBlob :: Filter a -> [Blob] -> [Blob]
filterQBlob q = filter (evalQBlob q)