module CodeWorld.Test.Solution (
  PicPredicate,
  containsElem,
  containsElems,
  containsExactElems,
  evaluatePred,
  evaluatePreds,
  hasRelation,
  (<||>),
  option,
  options,
  ifThen,
  thisOften,
  atLeast,
  atMost,
  inRangeOf,
  findMaybe,
  findAll,
  findAllAnd,
  findMaybeAnd,
  findAllActual,
  findMaybeActual,
  findAllActualAnd,
  findMaybeActualAnd,
  oneOf,
  getComponents,
  ) where


import Data.Maybe (listToMaybe)

import CodeWorld.Tasks.Picture (Picture, toInterface)
import CodeWorld.Test.Normalize (
  NormalizedPicture(..),
  contains,
  count,
  getSubPictures,
  )
import CodeWorld.Test.Relative (
  Components(..),
  SpatialQuery,
  toRelative,
  )


{- |
Alias for predicates on `Components`.
-}
type PicPredicate = Components -> Bool


{- |
At least one of many predicates evaluates to True.
-}
options :: [PicPredicate] -> PicPredicate
options :: [PicPredicate] -> PicPredicate
options [PicPredicate]
ps Components
c = (PicPredicate -> Bool) -> [PicPredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\PicPredicate
p -> PicPredicate
p Components
c) [PicPredicate]
ps


{- |
At least one of two predicates evaluates to True.
-}
(<||>) :: PicPredicate -> PicPredicate -> PicPredicate
<||> :: PicPredicate -> PicPredicate -> PicPredicate
(<||>) PicPredicate
p PicPredicate
q Components
c = PicPredicate
p Components
c Bool -> Bool -> Bool
|| PicPredicate
q Components
c


{- |
Alias for (`<||>`)
-}
option :: PicPredicate -> PicPredicate -> PicPredicate
option :: PicPredicate -> PicPredicate -> PicPredicate
option = PicPredicate -> PicPredicate -> PicPredicate
(<||>)


{- |
The predicate is satisfied by at least one of the given options.
Use when there's multiple shape primitives a student could use to solve the task.
-}
oneOf :: (a -> PicPredicate) -> [a] ->  PicPredicate
oneOf :: forall a. (a -> PicPredicate) -> [a] -> PicPredicate
oneOf a -> PicPredicate
p = (a -> PicPredicate -> PicPredicate)
-> PicPredicate -> [a] -> PicPredicate
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (PicPredicate -> PicPredicate -> PicPredicate
(<||>) (PicPredicate -> PicPredicate -> PicPredicate)
-> (a -> PicPredicate) -> a -> PicPredicate -> PicPredicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PicPredicate
p) (Bool -> PicPredicate
forall a b. a -> b -> a
const Bool
False)


-- Use a predicate on the list of sub images
specElems :: (NormalizedPicture -> Bool) -> PicPredicate
specElems :: (NormalizedPicture -> Bool) -> PicPredicate
specElems NormalizedPicture -> Bool
f (Components (NormalizedPicture
ps,[RelativePicSpec]
_)) = NormalizedPicture -> Bool
f NormalizedPicture
ps


{- |
Returns the first picture element satisfying the predicate if it exists. (translation is removed)
-}
findMaybe :: (NormalizedPicture -> Bool) -> Components -> Maybe NormalizedPicture
findMaybe :: (NormalizedPicture -> Bool)
-> Components -> Maybe NormalizedPicture
findMaybe NormalizedPicture -> Bool
f = [NormalizedPicture] -> Maybe NormalizedPicture
forall a. [a] -> Maybe a
listToMaybe ([NormalizedPicture] -> Maybe NormalizedPicture)
-> (Components -> [NormalizedPicture])
-> Components
-> Maybe NormalizedPicture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedPicture -> Bool) -> Components -> [NormalizedPicture]
findAll NormalizedPicture -> Bool
f


{- |
Returns all picture elements satisfying the predicate. (translation is removed)
-}
findAll :: (NormalizedPicture -> Bool) -> Components -> [NormalizedPicture]
findAll :: (NormalizedPicture -> Bool) -> Components -> [NormalizedPicture]
findAll NormalizedPicture -> Bool
f (Components (NormalizedPicture
ps,[RelativePicSpec]
_)) = (NormalizedPicture -> Bool)
-> [NormalizedPicture] -> [NormalizedPicture]
forall a. (a -> Bool) -> [a] -> [a]
filter NormalizedPicture -> Bool
f ([NormalizedPicture] -> [NormalizedPicture])
-> [NormalizedPicture] -> [NormalizedPicture]
forall a b. (a -> b) -> a -> b
$ NormalizedPicture -> [NormalizedPicture]
getSubPictures NormalizedPicture
ps


{- |
Returns all subpictures satisfying the predicate. (includes translation)
-}
findAllActual :: (NormalizedPicture -> Bool) -> Picture -> [NormalizedPicture]
findAllActual :: (NormalizedPicture -> Bool) -> Picture -> [NormalizedPicture]
findAllActual NormalizedPicture -> Bool
f = (NormalizedPicture -> Bool)
-> [NormalizedPicture] -> [NormalizedPicture]
forall a. (a -> Bool) -> [a] -> [a]
filter NormalizedPicture -> Bool
f ([NormalizedPicture] -> [NormalizedPicture])
-> (Picture -> [NormalizedPicture])
-> Picture
-> [NormalizedPicture]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedPicture -> [NormalizedPicture]
getSubPictures (NormalizedPicture -> [NormalizedPicture])
-> (Picture -> NormalizedPicture) -> Picture -> [NormalizedPicture]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Picture -> NormalizedPicture
forall a. Drawable a => Picture -> a
toInterface


{- |
Returns the first subpicture satisfying the predicate if it exists. (includes translation)
-}
findMaybeActual :: (NormalizedPicture -> Bool) -> Picture -> Maybe NormalizedPicture
findMaybeActual :: (NormalizedPicture -> Bool) -> Picture -> Maybe NormalizedPicture
findMaybeActual NormalizedPicture -> Bool
f = [NormalizedPicture] -> Maybe NormalizedPicture
forall a. [a] -> Maybe a
listToMaybe ([NormalizedPicture] -> Maybe NormalizedPicture)
-> (Picture -> [NormalizedPicture])
-> Picture
-> Maybe NormalizedPicture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedPicture -> Bool) -> Picture -> [NormalizedPicture]
findAllActual NormalizedPicture -> Bool
f


{- |
Finds all subpictures satisfying a predicate, then applies a function. (includes translation)
-}
findAllActualAnd :: (NormalizedPicture -> Bool) -> (NormalizedPicture -> a) -> Picture -> [a]
findAllActualAnd :: forall a.
(NormalizedPicture -> Bool)
-> (NormalizedPicture -> a) -> Picture -> [a]
findAllActualAnd NormalizedPicture -> Bool
f NormalizedPicture -> a
g = (NormalizedPicture -> a) -> [NormalizedPicture] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map NormalizedPicture -> a
g ([NormalizedPicture] -> [a])
-> (Picture -> [NormalizedPicture]) -> Picture -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedPicture -> Bool) -> Picture -> [NormalizedPicture]
findAllActual NormalizedPicture -> Bool
f


{- |
Finds the first subpicture satisfying a predicate, then applies a function if it exists. (includes translation)
-}
findMaybeActualAnd :: (NormalizedPicture -> Bool) -> (NormalizedPicture -> a) -> Picture -> Maybe a
findMaybeActualAnd :: forall a.
(NormalizedPicture -> Bool)
-> (NormalizedPicture -> a) -> Picture -> Maybe a
findMaybeActualAnd NormalizedPicture -> Bool
f NormalizedPicture -> a
g = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> (Picture -> [a]) -> Picture -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedPicture -> Bool)
-> (NormalizedPicture -> a) -> Picture -> [a]
forall a.
(NormalizedPicture -> Bool)
-> (NormalizedPicture -> a) -> Picture -> [a]
findAllActualAnd NormalizedPicture -> Bool
f NormalizedPicture -> a
g


{- |
Finds all picture elements satisfying a predicate, then applies a function. (translation is removed)
-}
findAllAnd :: (NormalizedPicture -> Bool) -> (NormalizedPicture -> a) -> Components -> [a]
findAllAnd :: forall a.
(NormalizedPicture -> Bool)
-> (NormalizedPicture -> a) -> Components -> [a]
findAllAnd NormalizedPicture -> Bool
f NormalizedPicture -> a
g = (NormalizedPicture -> a) -> [NormalizedPicture] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map NormalizedPicture -> a
g ([NormalizedPicture] -> [a])
-> (Components -> [NormalizedPicture]) -> Components -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedPicture -> Bool) -> Components -> [NormalizedPicture]
findAll NormalizedPicture -> Bool
f


{- |
Finds the first element satisfying a predicate, then applies a function if it exists. (translation is removed)
-}
findMaybeAnd :: (NormalizedPicture -> Bool) -> (NormalizedPicture -> a) -> Components -> Maybe a
findMaybeAnd :: forall a.
(NormalizedPicture -> Bool)
-> (NormalizedPicture -> a) -> Components -> Maybe a
findMaybeAnd NormalizedPicture -> Bool
f NormalizedPicture -> a
g = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> (Components -> [a]) -> Components -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedPicture -> Bool)
-> (NormalizedPicture -> a) -> Components -> [a]
forall a.
(NormalizedPicture -> Bool)
-> (NormalizedPicture -> a) -> Components -> [a]
findAllAnd NormalizedPicture -> Bool
f NormalizedPicture -> a
g


{- |
True if image contains exactly these subpictures and nothing else.
-}
containsExactElems :: [NormalizedPicture] -> PicPredicate
containsExactElems :: [NormalizedPicture] -> PicPredicate
containsExactElems [NormalizedPicture]
ps = (NormalizedPicture -> Bool) -> PicPredicate
specElems ((NormalizedPicture -> Bool) -> [NormalizedPicture] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\NormalizedPicture
tp -> [NormalizedPicture] -> NormalizedPicture
Pictures [NormalizedPicture]
ps NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
tp) ([NormalizedPicture] -> Bool)
-> (NormalizedPicture -> [NormalizedPicture])
-> NormalizedPicture
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedPicture -> [NormalizedPicture]
getSubPictures)

{- |
True if image contains at least this subpicture and optionally something else.
-}
containsElem :: NormalizedPicture -> PicPredicate
containsElem :: NormalizedPicture -> PicPredicate
containsElem NormalizedPicture
p = (NormalizedPicture -> Bool) -> PicPredicate
specElems (NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
p)

{- |
True if image contains at least these subpictures and optionally something else.
-}
containsElems :: [NormalizedPicture] -> PicPredicate
containsElems :: [NormalizedPicture] -> PicPredicate
containsElems [NormalizedPicture]
ps = (NormalizedPicture -> Bool) -> PicPredicate
specElems (\NormalizedPicture
t -> (NormalizedPicture -> Bool) -> [NormalizedPicture] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\NormalizedPicture
p -> NormalizedPicture
t NormalizedPicture -> NormalizedPicture -> Bool
`contains` NormalizedPicture
p) [NormalizedPicture]
ps)


{- |
True if image contains this subpicture exactly this many times.
-}
thisOften :: NormalizedPicture -> Int -> PicPredicate
thisOften :: NormalizedPicture -> Int -> PicPredicate
thisOften NormalizedPicture
p Int
amount = (NormalizedPicture -> Bool) -> PicPredicate
specElems (\NormalizedPicture
ps -> NormalizedPicture -> NormalizedPicture -> Int
count NormalizedPicture
p NormalizedPicture
ps Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
amount)


{- |
True if image contains this subpicture at least this many times.
-}
atLeast :: NormalizedPicture -> Int -> PicPredicate
atLeast :: NormalizedPicture -> Int -> PicPredicate
atLeast NormalizedPicture
p Int
amount = (NormalizedPicture -> Bool) -> PicPredicate
specElems (\NormalizedPicture
ps -> NormalizedPicture -> NormalizedPicture -> Int
count NormalizedPicture
p NormalizedPicture
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
amount)


{- |
True if image contains this subpicture at most many times.
-}
atMost :: NormalizedPicture -> Int -> PicPredicate
atMost :: NormalizedPicture -> Int -> PicPredicate
atMost NormalizedPicture
p Int
amount = (NormalizedPicture -> Bool) -> PicPredicate
specElems (\NormalizedPicture
ps -> NormalizedPicture -> NormalizedPicture -> Int
count NormalizedPicture
p NormalizedPicture
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
amount)


{- |
True if amount of times this subpicture is contained in the image lies in the specified range.
-}
inRangeOf :: NormalizedPicture -> (Int,Int) -> PicPredicate
inRangeOf :: NormalizedPicture -> (Int, Int) -> PicPredicate
inRangeOf NormalizedPicture
p (Int
lower,Int
upper) = (NormalizedPicture -> Bool) -> PicPredicate
specElems (\NormalizedPicture
ps -> let occurs :: Int
occurs = NormalizedPicture -> NormalizedPicture -> Int
count NormalizedPicture
p NormalizedPicture
ps in Int
occurs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lower Bool -> Bool -> Bool
&& Int
occurs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
upper)


{- |
Runs the first predicate p, then the second q if p evaluated to `True`.
Does not run q if p evaluates to `False`.
-}
ifThen :: PicPredicate -> PicPredicate -> PicPredicate
ifThen :: PicPredicate -> PicPredicate -> PicPredicate
ifThen PicPredicate
f PicPredicate
g Components
comp = Bool -> Bool
not (PicPredicate
f Components
comp) Bool -> Bool -> Bool
|| PicPredicate
g Components
comp


-- Use a predicate on the list of relative positions
specPosition :: SpatialQuery -> PicPredicate
specPosition :: SpatialQuery -> PicPredicate
specPosition SpatialQuery
f (Components (NormalizedPicture
_,[RelativePicSpec]
rP)) = SpatialQuery
f [RelativePicSpec]
rP


{- |
Evaluates given predicates on a student submission.
-}
evaluatePreds :: [PicPredicate] -> Picture -> Bool
evaluatePreds :: [PicPredicate] -> Picture -> Bool
evaluatePreds [PicPredicate]
fs Picture
pic = (PicPredicate -> Bool) -> [PicPredicate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (PicPredicate -> Picture -> Bool
`evaluatePred` Picture
pic) [PicPredicate]
fs


{- |
Evaluates the given predicate on a student submission.
-}
evaluatePred :: PicPredicate -> Picture -> Bool
evaluatePred :: PicPredicate -> Picture -> Bool
evaluatePred PicPredicate
f = PicPredicate
f PicPredicate -> (Picture -> Components) -> Picture -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Picture -> Components
getComponents


{- |
Transforms student submission into spatial `Components` form.
-}
getComponents :: Picture -> Components
getComponents :: Picture -> Components
getComponents = NormalizedPicture -> Components
toRelative (NormalizedPicture -> Components)
-> (Picture -> NormalizedPicture) -> Picture -> Components
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Picture -> NormalizedPicture
forall a. Drawable a => Picture -> a
toInterface


{- |
True if image contains the specified spatial relations.
Used with corresponding functions like `CodeWorld.Test.isNorthOf`, `CodeWorld.Test.isLeftOf`, etc.
-}
hasRelation :: SpatialQuery -> PicPredicate
hasRelation :: SpatialQuery -> PicPredicate
hasRelation = SpatialQuery -> PicPredicate
specPosition