{-# LANGUAGE FlexibleContexts #-}

module CodeWorld.Test.Solution (
  StaticImage,
  Animation,
  complain,
  testPicture,
  testAnimation,
  containsElem,
  containsElems,
  containsExactElems,
  hasRelation,
  (<||>),
  (<&&>),
  (<^^>),
  option,
  options,
  ifThen,
  thisOften,
  atLeast,
  atMost,
  inRangeOf,
  rawImage,
  normalizedImage,
  findAll,
  findAllThen,
  findAllTranslated,
  findAllTranslatedThen,
  findFirst,
  findFirstThen,
  findFirstTranslated,
  findFirstTranslatedThen,
  oneOf,
  mapAnimation,
  atTime,
  rawImagesAt,
  normalizedImagesAt,
  allAt,
  allAtWithTime,
  anyAt,
  noneAt,
  queryAt,
  ) where

import Control.Monad (unless)
import Control.Monad.Except             (Except, runExcept, throwError)
import Control.Monad.Reader (
  MonadReader,
  Reader,
  ReaderT,
  ask,
  asks,
  runReader,
  runReaderT,
  withReaderT
  )
import Data.Either (fromLeft)
import Data.Maybe (listToMaybe)
import Data.Traversable (for)

import CodeWorld.Tasks.Picture (Picture)
import CodeWorld.Test.Abstract (
  AbstractPicture(..),
  contains,
  count,
  getSubPictures,
  stripTranslation,
  )
import CodeWorld.Test.Relative (
  Components(..),
  SpatialQuery,
  toRelative,
  )
import CodeWorld.Test.Rewrite (
  normalize,
  normalizeAndAbstract
  )


{- |
The environment for tests on still images.
-}
type StaticImage = (Picture, Components)


{- |
The environment for tests on animations.
-}
type Animation = Double -> StaticImage


{- |
At least one of many predicates evaluates to True.
-}
options :: MonadReader env m => [m Bool] -> m Bool
options :: forall env (m :: * -> *). MonadReader env m => [m Bool] -> m Bool
options = (m Bool -> m Bool -> m Bool) -> m Bool -> [m Bool] -> m Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr m Bool -> m Bool -> m Bool
forall env (m :: * -> *).
MonadReader env m =>
m Bool -> m Bool -> m Bool
(<||>) (Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)


{- |
At least one of two predicates evaluates to True.
-}
(<||>) :: MonadReader env m => m Bool -> m Bool -> m Bool
<||> :: forall env (m :: * -> *).
MonadReader env m =>
m Bool -> m Bool -> m Bool
(<||>) m Bool
p m Bool
q = Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> m Bool -> m (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
p m (Bool -> Bool) -> m Bool -> m Bool
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Bool
q


{- |
Both predicates evaluate to True.
-}
(<&&>) :: MonadReader env m => m Bool -> m Bool -> m Bool
<&&> :: forall env (m :: * -> *).
MonadReader env m =>
m Bool -> m Bool -> m Bool
(<&&>) m Bool
p m Bool
q = Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> m Bool -> m (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
p m (Bool -> Bool) -> m Bool -> m Bool
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Bool
q


{- |
Only one of two predicates evaluate to True (XOR).
-}
(<^^>) :: MonadReader env m => m Bool -> m Bool -> m Bool
<^^> :: forall env (m :: * -> *).
MonadReader env m =>
m Bool -> m Bool -> m Bool
(<^^>) m Bool
a m Bool
b = Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
a m Bool -> m Bool -> m Bool
forall env (m :: * -> *).
MonadReader env m =>
m Bool -> m Bool -> m Bool
<&&> m Bool
b


{- |
Alias for (`<||>`)
-}
option :: MonadReader env m => m Bool -> m Bool -> m Bool
option :: forall env (m :: * -> *).
MonadReader env m =>
m Bool -> m Bool -> m Bool
option = m Bool -> m Bool -> m Bool
forall env (m :: * -> *).
MonadReader env m =>
m Bool -> m Bool -> m Bool
(<||>)


{- |
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 :: MonadReader env m => (a -> m Bool) -> [a] ->  m Bool
oneOf :: forall env (m :: * -> *) a.
MonadReader env m =>
(a -> m Bool) -> [a] -> m Bool
oneOf a -> m Bool
p = ([Bool] -> Bool) -> m [Bool] -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (m [Bool] -> m Bool) -> ([a] -> m [Bool]) -> [a] -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m Bool) -> [a] -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m Bool
p


-- Apply a function to the list of sub images and retrieve the result
specElems :: (AbstractPicture -> a) -> (Components -> a)
specElems :: forall a. (AbstractPicture -> a) -> Components -> a
specElems AbstractPicture -> a
f (Components (AbstractPicture
ps,[RelativePicSpec]
_)) = AbstractPicture -> a
f AbstractPicture
ps


{- |
Returns the first subpictures satisfying the predicate if it exists. (translation is removed)
-}
findFirst
  :: MonadReader StaticImage m
  => (AbstractPicture -> Bool)
  -> m (Maybe AbstractPicture)
findFirst :: forall (m :: * -> *).
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> m (Maybe AbstractPicture)
findFirst = ([AbstractPicture] -> Maybe AbstractPicture)
-> m [AbstractPicture] -> m (Maybe AbstractPicture)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [AbstractPicture] -> Maybe AbstractPicture
forall a. [a] -> Maybe a
listToMaybe (m [AbstractPicture] -> m (Maybe AbstractPicture))
-> ((AbstractPicture -> Bool) -> m [AbstractPicture])
-> (AbstractPicture -> Bool)
-> m (Maybe AbstractPicture)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractPicture -> Bool) -> m [AbstractPicture]
forall (m :: * -> *).
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> m [AbstractPicture]
findAll


{- |
Returns all subpictures satisfying the predicate. (translation is removed)
-}
findAll
  :: MonadReader StaticImage m
  => (AbstractPicture -> Bool)
  -> m [AbstractPicture]
findAll :: forall (m :: * -> *).
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> m [AbstractPicture]
findAll AbstractPicture -> Bool
f = (StaticImage -> [AbstractPicture]) -> m [AbstractPicture]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> [AbstractPicture]) -> m [AbstractPicture])
-> (StaticImage -> [AbstractPicture]) -> m [AbstractPicture]
forall a b. (a -> b) -> a -> b
$ (AbstractPicture -> Bool) -> [AbstractPicture] -> [AbstractPicture]
forall a. (a -> Bool) -> [a] -> [a]
filter AbstractPicture -> Bool
f ([AbstractPicture] -> [AbstractPicture])
-> (StaticImage -> [AbstractPicture])
-> StaticImage
-> [AbstractPicture]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractPicture -> [AbstractPicture])
-> Components -> [AbstractPicture]
forall a. (AbstractPicture -> a) -> Components -> a
specElems ((AbstractPicture -> AbstractPicture)
-> [AbstractPicture] -> [AbstractPicture]
forall a b. (a -> b) -> [a] -> [b]
map AbstractPicture -> AbstractPicture
stripTranslation ([AbstractPicture] -> [AbstractPicture])
-> (AbstractPicture -> [AbstractPicture])
-> AbstractPicture
-> [AbstractPicture]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractPicture -> [AbstractPicture]
getSubPictures) (Components -> [AbstractPicture])
-> (StaticImage -> Components) -> StaticImage -> [AbstractPicture]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd


{- |
Returns all subpictures satisfying the predicate. (includes translation)
-}
findAllTranslated
  :: MonadReader StaticImage m
  => (AbstractPicture -> Bool)
  -> m [AbstractPicture]
findAllTranslated :: forall (m :: * -> *).
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> m [AbstractPicture]
findAllTranslated AbstractPicture -> Bool
f = (StaticImage -> [AbstractPicture]) -> m [AbstractPicture]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> [AbstractPicture]) -> m [AbstractPicture])
-> (StaticImage -> [AbstractPicture]) -> m [AbstractPicture]
forall a b. (a -> b) -> a -> b
$ (AbstractPicture -> Bool) -> [AbstractPicture] -> [AbstractPicture]
forall a. (a -> Bool) -> [a] -> [a]
filter AbstractPicture -> Bool
f ([AbstractPicture] -> [AbstractPicture])
-> (StaticImage -> [AbstractPicture])
-> StaticImage
-> [AbstractPicture]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractPicture -> [AbstractPicture])
-> Components -> [AbstractPicture]
forall a. (AbstractPicture -> a) -> Components -> a
specElems AbstractPicture -> [AbstractPicture]
getSubPictures (Components -> [AbstractPicture])
-> (StaticImage -> Components) -> StaticImage -> [AbstractPicture]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd


{- |
Returns the first subpicture satisfying the predicate if it exists. (includes translation)
-}
findFirstTranslated
  :: MonadReader StaticImage m
  => (AbstractPicture -> Bool)
  -> m (Maybe AbstractPicture)
findFirstTranslated :: forall (m :: * -> *).
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> m (Maybe AbstractPicture)
findFirstTranslated = ([AbstractPicture] -> Maybe AbstractPicture)
-> m [AbstractPicture] -> m (Maybe AbstractPicture)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [AbstractPicture] -> Maybe AbstractPicture
forall a. [a] -> Maybe a
listToMaybe (m [AbstractPicture] -> m (Maybe AbstractPicture))
-> ((AbstractPicture -> Bool) -> m [AbstractPicture])
-> (AbstractPicture -> Bool)
-> m (Maybe AbstractPicture)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractPicture -> Bool) -> m [AbstractPicture]
forall (m :: * -> *).
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> m [AbstractPicture]
findAllTranslated


{- |
Finds all subpictures satisfying a predicate, then applies a function. (includes translation)
-}
findAllTranslatedThen
  :: MonadReader StaticImage m
  => (AbstractPicture -> Bool)
  -> (AbstractPicture -> a)
  -> m [a]
findAllTranslatedThen :: forall (m :: * -> *) a.
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> (AbstractPicture -> a) -> m [a]
findAllTranslatedThen AbstractPicture -> Bool
p AbstractPicture -> a
f = (AbstractPicture -> a) -> [AbstractPicture] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map AbstractPicture -> a
f ([AbstractPicture] -> [a]) -> m [AbstractPicture] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AbstractPicture -> Bool) -> m [AbstractPicture]
forall (m :: * -> *).
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> m [AbstractPicture]
findAllTranslated AbstractPicture -> Bool
p


{- |
Finds the first subpicture satisfying a predicate, then applies a function if it exists. (includes translation)
-}
findFirstTranslatedThen
  :: MonadReader StaticImage m
  => (AbstractPicture -> Bool)
  -> (AbstractPicture -> a)
  -> m (Maybe a)
findFirstTranslatedThen :: forall (m :: * -> *) a.
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> (AbstractPicture -> a) -> m (Maybe a)
findFirstTranslatedThen AbstractPicture -> Bool
p = ([a] -> Maybe a) -> m [a] -> m (Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe (m [a] -> m (Maybe a))
-> ((AbstractPicture -> a) -> m [a])
-> (AbstractPicture -> a)
-> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractPicture -> Bool) -> (AbstractPicture -> a) -> m [a]
forall (m :: * -> *) a.
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> (AbstractPicture -> a) -> m [a]
findAllTranslatedThen AbstractPicture -> Bool
p


{- |
Finds all subpictures satisfying a predicate, then applies a function. (translation is removed)
-}
findAllThen
  :: MonadReader StaticImage m
  => (AbstractPicture -> Bool)
  -> (AbstractPicture -> a)
  -> m [a]
findAllThen :: forall (m :: * -> *) a.
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> (AbstractPicture -> a) -> m [a]
findAllThen AbstractPicture -> Bool
f AbstractPicture -> a
g = (AbstractPicture -> a) -> [AbstractPicture] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map AbstractPicture -> a
g ([AbstractPicture] -> [a]) -> m [AbstractPicture] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AbstractPicture -> Bool) -> m [AbstractPicture]
forall (m :: * -> *).
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> m [AbstractPicture]
findAll AbstractPicture -> Bool
f


{- |
Finds the first subpictures satisfying a predicate, then applies a function if it exists. (translation is removed)
-}
findFirstThen
  :: MonadReader StaticImage m
  => (AbstractPicture -> Bool)
  -> (AbstractPicture -> a)
  -> m (Maybe a)
findFirstThen :: forall (m :: * -> *) a.
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> (AbstractPicture -> a) -> m (Maybe a)
findFirstThen AbstractPicture -> Bool
f = ([a] -> Maybe a) -> m [a] -> m (Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe (m [a] -> m (Maybe a))
-> ((AbstractPicture -> a) -> m [a])
-> (AbstractPicture -> a)
-> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractPicture -> Bool) -> (AbstractPicture -> a) -> m [a]
forall (m :: * -> *) a.
MonadReader StaticImage m =>
(AbstractPicture -> Bool) -> (AbstractPicture -> a) -> m [a]
findAllThen AbstractPicture -> Bool
f


{- |
Returns the unmodified Picture.
-}
rawImage :: MonadReader StaticImage m => m Picture
rawImage :: forall (m :: * -> *). MonadReader StaticImage m => m Picture
rawImage = (StaticImage -> Picture) -> m Picture
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks StaticImage -> Picture
forall a b. (a, b) -> a
fst


{- |
Returns the normalized Picture.
-}
normalizedImage :: MonadReader StaticImage m => m Picture
normalizedImage :: forall (m :: * -> *). MonadReader StaticImage m => m Picture
normalizedImage = (StaticImage -> Picture) -> m Picture
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Picture -> Picture
normalize (Picture -> Picture)
-> (StaticImage -> Picture) -> StaticImage -> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Picture
forall a b. (a, b) -> a
fst)


{- |
True if image contains exactly these subpictures and nothing else.
-}
containsExactElems
  :: MonadReader StaticImage m
  => [AbstractPicture]
  -> m Bool
containsExactElems :: forall (m :: * -> *).
MonadReader StaticImage m =>
[AbstractPicture] -> m Bool
containsExactElems [AbstractPicture]
ps = (StaticImage -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> Bool) -> m Bool)
-> (StaticImage -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (AbstractPicture -> Bool) -> Components -> Bool
forall a. (AbstractPicture -> a) -> Components -> a
specElems
  ((AbstractPicture -> Bool) -> [AbstractPicture] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\AbstractPicture
tp -> [AbstractPicture] -> AbstractPicture
Pictures [AbstractPicture]
ps AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
tp) ([AbstractPicture] -> Bool)
-> (AbstractPicture -> [AbstractPicture])
-> AbstractPicture
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractPicture -> [AbstractPicture]
getSubPictures) (Components -> Bool)
-> (StaticImage -> Components) -> StaticImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd


{- |
True if image contains at least this subpicture and optionally something else.
-}
containsElem :: MonadReader StaticImage m => AbstractPicture -> m Bool
containsElem :: forall (m :: * -> *).
MonadReader StaticImage m =>
AbstractPicture -> m Bool
containsElem AbstractPicture
p = (StaticImage -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> Bool) -> m Bool)
-> (StaticImage -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (AbstractPicture -> Bool) -> Components -> Bool
forall a. (AbstractPicture -> a) -> Components -> a
specElems (AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p) (Components -> Bool)
-> (StaticImage -> Components) -> StaticImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd

{- |
True if image contains at least these subpictures and optionally something else.
-}
containsElems :: MonadReader StaticImage m => [AbstractPicture] -> m Bool
containsElems :: forall (m :: * -> *).
MonadReader StaticImage m =>
[AbstractPicture] -> m Bool
containsElems [AbstractPicture]
ps = (StaticImage -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> Bool) -> m Bool)
-> (StaticImage -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (AbstractPicture -> Bool) -> Components -> Bool
forall a. (AbstractPicture -> a) -> Components -> a
specElems (\AbstractPicture
t -> (AbstractPicture -> Bool) -> [AbstractPicture] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\AbstractPicture
p -> AbstractPicture
t AbstractPicture -> AbstractPicture -> Bool
`contains` AbstractPicture
p) [AbstractPicture]
ps) (Components -> Bool)
-> (StaticImage -> Components) -> StaticImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd


{- |
True if image contains this subpicture exactly this many times.
-}
thisOften :: MonadReader StaticImage m => AbstractPicture -> Int -> m Bool
thisOften :: forall (m :: * -> *).
MonadReader StaticImage m =>
AbstractPicture -> Int -> m Bool
thisOften AbstractPicture
p Int
amount = (StaticImage -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> Bool) -> m Bool)
-> (StaticImage -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (AbstractPicture -> Bool) -> Components -> Bool
forall a. (AbstractPicture -> a) -> Components -> a
specElems (\AbstractPicture
ps -> AbstractPicture -> AbstractPicture -> Int
count AbstractPicture
p AbstractPicture
ps Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
amount) (Components -> Bool)
-> (StaticImage -> Components) -> StaticImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd


{- |
True if image contains this subpicture at least this many times.
-}
atLeast :: MonadReader StaticImage m => AbstractPicture -> Int -> m Bool
atLeast :: forall (m :: * -> *).
MonadReader StaticImage m =>
AbstractPicture -> Int -> m Bool
atLeast AbstractPicture
p Int
amount = (StaticImage -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> Bool) -> m Bool)
-> (StaticImage -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (AbstractPicture -> Bool) -> Components -> Bool
forall a. (AbstractPicture -> a) -> Components -> a
specElems (\AbstractPicture
ps -> AbstractPicture -> AbstractPicture -> Int
count AbstractPicture
p AbstractPicture
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
amount) (Components -> Bool)
-> (StaticImage -> Components) -> StaticImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd


{- |
True if image contains this subpicture at most many times.
-}
atMost :: MonadReader StaticImage m => AbstractPicture -> Int -> m Bool
atMost :: forall (m :: * -> *).
MonadReader StaticImage m =>
AbstractPicture -> Int -> m Bool
atMost AbstractPicture
p Int
amount = (StaticImage -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> Bool) -> m Bool)
-> (StaticImage -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (AbstractPicture -> Bool) -> Components -> Bool
forall a. (AbstractPicture -> a) -> Components -> a
specElems (\AbstractPicture
ps -> AbstractPicture -> AbstractPicture -> Int
count AbstractPicture
p AbstractPicture
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
amount) (Components -> Bool)
-> (StaticImage -> Components) -> StaticImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd


{- |
True if amount of times this subpicture is contained in the image lies in the specified range.
-}
inRangeOf
  :: MonadReader StaticImage m
  => AbstractPicture
  -> (Int,Int)
  -> m Bool
inRangeOf :: forall (m :: * -> *).
MonadReader StaticImage m =>
AbstractPicture -> (Int, Int) -> m Bool
inRangeOf AbstractPicture
p (Int
lower,Int
upper) = (StaticImage -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> Bool) -> m Bool)
-> (StaticImage -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ (AbstractPicture -> Bool) -> Components -> Bool
forall a. (AbstractPicture -> a) -> Components -> a
specElems (
  \AbstractPicture
ps -> let occurs :: Int
occurs = AbstractPicture -> AbstractPicture -> Int
count AbstractPicture
p AbstractPicture
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
  ) (Components -> Bool)
-> (StaticImage -> Components) -> StaticImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd


{- |
Runs the first predicate p, then the second q if p evaluated to `True`.
Does not run q if p evaluates to `False`.
-}
ifThen :: MonadReader env m => m Bool -> m Bool -> m Bool
ifThen :: forall env (m :: * -> *).
MonadReader env m =>
m Bool -> m Bool -> m Bool
ifThen m Bool
p m Bool
q = (Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
p) m Bool -> m Bool -> m Bool
forall env (m :: * -> *).
MonadReader env m =>
m Bool -> m Bool -> m Bool
<||> m Bool
q


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


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


{- |
True if image contains the specified spatial relations.
Used with corresponding functions like `CodeWorld.Test.isNorthOf`, `CodeWorld.Test.isLeftOf`, etc.
-}
hasRelation :: MonadReader StaticImage m => SpatialQuery -> m Bool
hasRelation :: forall (m :: * -> *).
MonadReader StaticImage m =>
SpatialQuery -> m Bool
hasRelation SpatialQuery
q = (StaticImage -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((StaticImage -> Bool) -> m Bool)
-> (StaticImage -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ SpatialQuery -> Components -> Bool
specPosition SpatialQuery
q (Components -> Bool)
-> (StaticImage -> Components) -> StaticImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticImage -> Components
forall a b. (a, b) -> b
snd


{- |
Returns the animation environment with its output mapped over by the argument.
-}
mapAnimation
  :: MonadReader Animation m
  => (StaticImage -> a)
  -> m (Double -> a)
mapAnimation :: forall (m :: * -> *) a.
MonadReader Animation m =>
(StaticImage -> a) -> m (Double -> a)
mapAnimation = (Animation -> Double -> a) -> m (Double -> a)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Animation -> Double -> a) -> m (Double -> a))
-> ((StaticImage -> a) -> Animation -> Double -> a)
-> (StaticImage -> a)
-> m (Double -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StaticImage -> a) -> Animation -> Double -> a
forall a b. (a -> b) -> (Double -> a) -> Double -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap


{- |
Samples the animation at the given time point and applies a predicate or query to it.
-}
atTime :: Double -> ReaderT StaticImage m a -> ReaderT Animation m a
atTime :: forall (m :: * -> *) a.
Double -> ReaderT StaticImage m a -> ReaderT Animation m a
atTime Double
time = (Animation -> StaticImage)
-> ReaderT StaticImage m a -> ReaderT Animation m a
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (Animation -> Animation
forall a b. (a -> b) -> a -> b
$ Double
time)


{- |
Samples the animation at multiple time points and applies a predicate or query to each image,
then returns a list of results.
-}
queryAt
  :: Applicative m
  => [Double]
  -> ReaderT StaticImage m a
  -> ReaderT Animation m [a]
queryAt :: forall (m :: * -> *) a.
Applicative m =>
[Double] -> ReaderT StaticImage m a -> ReaderT Animation m [a]
queryAt [Double]
frames = [Double]
-> (Double -> ReaderT Animation m a) -> ReaderT Animation m [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Double]
frames ((Double -> ReaderT Animation m a) -> ReaderT Animation m [a])
-> (ReaderT StaticImage m a -> Double -> ReaderT Animation m a)
-> ReaderT StaticImage m a
-> ReaderT Animation m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> ReaderT StaticImage m a -> ReaderT Animation m a)
-> ReaderT StaticImage m a -> Double -> ReaderT Animation m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Double -> ReaderT StaticImage m a -> ReaderT Animation m a
forall (m :: * -> *) a.
Double -> ReaderT StaticImage m a -> ReaderT Animation m a
atTime


{- |
Samples the animation at multiple time points
and applies a predicate dependent on the current time point to each image.
Returns 'True' if all samples satisfied the predicate.
-}
queryAtWithTime
  :: Applicative m
  => [Double]
  -> (Double -> ReaderT StaticImage m a)
  -> ReaderT Animation m [a]
queryAtWithTime :: forall (m :: * -> *) a.
Applicative m =>
[Double]
-> (Double -> ReaderT StaticImage m a) -> ReaderT Animation m [a]
queryAtWithTime [Double]
frames Double -> ReaderT StaticImage m a
action = [Double]
-> (Double -> ReaderT Animation m a) -> ReaderT Animation m [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Double]
frames ((Double -> ReaderT Animation m a) -> ReaderT Animation m [a])
-> (Double -> ReaderT Animation m a) -> ReaderT Animation m [a]
forall a b. (a -> b) -> a -> b
$ \Double
t -> Double -> ReaderT StaticImage m a -> ReaderT Animation m a
forall (m :: * -> *) a.
Double -> ReaderT StaticImage m a -> ReaderT Animation m a
atTime Double
t (Double -> ReaderT StaticImage m a
action Double
t)


{- |
Samples the animation at multiple time points and applies a predicate to each image.
Returns 'True' if all samples satisfied the predicate.
-}
allAt :: [Double] -> Reader StaticImage Bool -> Reader Animation Bool
allAt :: [Double] -> Reader StaticImage Bool -> Reader Animation Bool
allAt [Double]
frames = ([Bool] -> Bool)
-> ReaderT Animation Identity [Bool] -> Reader Animation Bool
forall a b.
(a -> b)
-> ReaderT Animation Identity a -> ReaderT Animation Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (ReaderT Animation Identity [Bool] -> Reader Animation Bool)
-> (Reader StaticImage Bool -> ReaderT Animation Identity [Bool])
-> Reader StaticImage Bool
-> Reader Animation Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double]
-> Reader StaticImage Bool -> ReaderT Animation Identity [Bool]
forall (m :: * -> *) a.
Applicative m =>
[Double] -> ReaderT StaticImage m a -> ReaderT Animation m [a]
queryAt [Double]
frames


{- |
Samples the animation at multiple time points
and applies a predicate dependent on the current time point to each image.
Returns 'True' if all samples satisfied the predicate.
-}
allAtWithTime
  :: [Double]
  -> (Double -> Reader StaticImage Bool)
  -> Reader Animation Bool
allAtWithTime :: [Double]
-> (Double -> Reader StaticImage Bool) -> Reader Animation Bool
allAtWithTime [Double]
frames = ([Bool] -> Bool)
-> ReaderT Animation Identity [Bool] -> Reader Animation Bool
forall a b.
(a -> b)
-> ReaderT Animation Identity a -> ReaderT Animation Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (ReaderT Animation Identity [Bool] -> Reader Animation Bool)
-> ((Double -> Reader StaticImage Bool)
    -> ReaderT Animation Identity [Bool])
-> (Double -> Reader StaticImage Bool)
-> Reader Animation Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double]
-> (Double -> Reader StaticImage Bool)
-> ReaderT Animation Identity [Bool]
forall (m :: * -> *) a.
Applicative m =>
[Double]
-> (Double -> ReaderT StaticImage m a) -> ReaderT Animation m [a]
queryAtWithTime [Double]
frames


{- |
Samples the animation at multiple time points and applies a predicate to each image.
Returns 'True' if any sample satisfied the predicate.
-}
anyAt :: [Double] -> Reader StaticImage Bool -> Reader Animation Bool
anyAt :: [Double] -> Reader StaticImage Bool -> Reader Animation Bool
anyAt [Double]
frames = ([Bool] -> Bool)
-> ReaderT Animation Identity [Bool] -> Reader Animation Bool
forall a b.
(a -> b)
-> ReaderT Animation Identity a -> ReaderT Animation Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (ReaderT Animation Identity [Bool] -> Reader Animation Bool)
-> (Reader StaticImage Bool -> ReaderT Animation Identity [Bool])
-> Reader StaticImage Bool
-> Reader Animation Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double]
-> Reader StaticImage Bool -> ReaderT Animation Identity [Bool]
forall (m :: * -> *) a.
Applicative m =>
[Double] -> ReaderT StaticImage m a -> ReaderT Animation m [a]
queryAt [Double]
frames


{- |
Samples the animation at multiple time points and applies a predicate to each image.
Returns 'True' if none of the samples satisfied the predicate.
-}
noneAt :: [Double] -> Reader StaticImage Bool -> Reader Animation Bool
noneAt :: [Double] -> Reader StaticImage Bool -> Reader Animation Bool
noneAt [Double]
frames = (Bool -> Bool) -> Reader Animation Bool -> Reader Animation Bool
forall a b.
(a -> b)
-> ReaderT Animation Identity a -> ReaderT Animation Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Reader Animation Bool -> Reader Animation Bool)
-> (Reader StaticImage Bool -> Reader Animation Bool)
-> Reader StaticImage Bool
-> Reader Animation Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Reader StaticImage Bool -> Reader Animation Bool
anyAt [Double]
frames



{- |
Samples the animation at multiple time points and returns a list of unmodified results.
-}
rawImagesAt :: Monad m => [Double] -> ReaderT Animation m [Picture]
rawImagesAt :: forall (m :: * -> *).
Monad m =>
[Double] -> ReaderT Animation m [Picture]
rawImagesAt [Double]
frames = [Double]
-> ReaderT StaticImage m Picture -> ReaderT Animation m [Picture]
forall (m :: * -> *) a.
Applicative m =>
[Double] -> ReaderT StaticImage m a -> ReaderT Animation m [a]
queryAt [Double]
frames ReaderT StaticImage m Picture
forall (m :: * -> *). MonadReader StaticImage m => m Picture
rawImage


{- |
Samples the animation at multiple time points and returns a list of normalized results.
-}
normalizedImagesAt :: Monad m => [Double] -> ReaderT Animation m [Picture]
normalizedImagesAt :: forall (m :: * -> *).
Monad m =>
[Double] -> ReaderT Animation m [Picture]
normalizedImagesAt [Double]
frames = [Double]
-> ReaderT StaticImage m Picture -> ReaderT Animation m [Picture]
forall (m :: * -> *) a.
Applicative m =>
[Double] -> ReaderT StaticImage m a -> ReaderT Animation m [a]
queryAt [Double]
frames ReaderT StaticImage m Picture
forall (m :: * -> *). MonadReader StaticImage m => m Picture
normalizedImage


{- |
Builds a fallible test given an error message and a predicate.
-}
complain :: String -> Reader env Bool -> ReaderT env (Except String) ()
complain :: forall env.
String -> Reader env Bool -> ReaderT env (Except String) ()
complain String
label Reader env Bool
action = do
  environment <- ReaderT env (Except String) env
forall r (m :: * -> *). MonadReader r m => m r
ask
  unless (runReader action environment) $ throwError label


{- |
Executes the given test suite on a static image and returns the error message of the first failed test
or the empty String if all tests passed.
-}
testPicture :: Picture -> ReaderT StaticImage (Except String) () -> String
testPicture :: Picture -> ReaderT StaticImage (Except String) () -> String
testPicture Picture
p = String -> Either String () -> String
forall a b. a -> Either a b -> a
fromLeft String
"" (Either String () -> String)
-> (ReaderT StaticImage (Except String) () -> Either String ())
-> ReaderT StaticImage (Except String) ()
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except String () -> Either String ()
forall e a. Except e a -> Either e a
runExcept (Except String () -> Either String ())
-> (ReaderT StaticImage (Except String) () -> Except String ())
-> ReaderT StaticImage (Except String) ()
-> Either String ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT StaticImage (Except String) ()
 -> StaticImage -> Except String ())
-> StaticImage
-> ReaderT StaticImage (Except String) ()
-> Except String ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT StaticImage (Except String) ()
-> StaticImage -> Except String ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Picture
p, Picture -> Components
getComponents Picture
p)


{- |
Executes the given test suite on an animation and returns the error message of the first failed test
or the empty String if all tests passed.
-}
testAnimation :: (Double -> Picture) -> ReaderT Animation (Except String) () -> String
testAnimation :: (Double -> Picture)
-> ReaderT Animation (Except String) () -> String
testAnimation Double -> Picture
p = String -> Either String () -> String
forall a b. a -> Either a b -> a
fromLeft String
"" (Either String () -> String)
-> (ReaderT Animation (Except String) () -> Either String ())
-> ReaderT Animation (Except String) ()
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except String () -> Either String ()
forall e a. Except e a -> Either e a
runExcept (Except String () -> Either String ())
-> (ReaderT Animation (Except String) () -> Except String ())
-> ReaderT Animation (Except String) ()
-> Either String ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Animation (Except String) ()
 -> Animation -> Except String ())
-> Animation
-> ReaderT Animation (Except String) ()
-> Except String ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Animation (Except String) ()
-> Animation -> Except String ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (\Double
t -> (Double -> Picture
p Double
t, Picture -> Components
getComponents (Picture -> Components) -> Picture -> Components
forall a b. (a -> b) -> a -> b
$ Double -> Picture
p Double
t))