{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE KindSignatures #-}
{-# OPTIONS_GHC -Wno-deprecations -Wno-name-shadowing -Wno-star-is-type #-}

{-
  Copyright 2020 The CodeWorld Authors. All rights reserved.

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
-}

module CodeWorld.App
  {-# WARNING "This is an experimental API.  It can change at any time." #-}
  ( Rule,
    eventRule,
    pictureRule,
    multiEventRule,
    multiPictureRule,
    subrule,
    rules,
    applicationOf,
    unsafeMultiApplicationOf,
  )
where

import CodeWorld
import Data.List (foldl')
import System.Random (StdGen)

data Rule :: * -> * where
  EventRule :: (Int -> Event -> state -> state) -> Rule state
  PictureRule :: (Int -> state -> Picture) -> Rule state
  Rules :: [Rule state] -> Rule state

eventRule :: (Event -> state -> state) -> Rule state
eventRule :: forall state. (Event -> state -> state) -> Rule state
eventRule = forall state. (Int -> Event -> state -> state) -> Rule state
EventRule forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

pictureRule :: (state -> Picture) -> Rule state
pictureRule :: forall state. (state -> Picture) -> Rule state
pictureRule = forall state. (Int -> state -> Picture) -> Rule state
PictureRule forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

multiEventRule :: (Int -> Event -> state -> state) -> Rule state
multiEventRule :: forall state. (Int -> Event -> state -> state) -> Rule state
multiEventRule = forall state. (Int -> Event -> state -> state) -> Rule state
EventRule

multiPictureRule :: (Int -> state -> Picture) -> Rule state
multiPictureRule :: forall state. (Int -> state -> Picture) -> Rule state
multiPictureRule = forall state. (Int -> state -> Picture) -> Rule state
PictureRule

subrule :: (a -> b) -> (b -> a -> a) -> Rule b -> Rule a
subrule :: forall a b. (a -> b) -> (b -> a -> a) -> Rule b -> Rule a
subrule a -> b
getter b -> a -> a
setter (EventRule Int -> Event -> b -> b
event_b) = forall state. (Int -> Event -> state -> state) -> Rule state
EventRule Int -> Event -> a -> a
event_a
  where
    event_a :: Int -> Event -> a -> a
event_a Int
k Event
ev a
a = b -> a -> a
setter (Int -> Event -> b -> b
event_b Int
k Event
ev (a -> b
getter a
a)) a
a
subrule a -> b
getter b -> a -> a
_setter (PictureRule Int -> b -> Picture
pic_b) = forall state. (Int -> state -> Picture) -> Rule state
PictureRule Int -> a -> Picture
pic_a
  where
    pic_a :: Int -> a -> Picture
pic_a Int
n = Int -> b -> Picture
pic_b Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
getter
subrule a -> b
getter b -> a -> a
setter (Rules [Rule b]
rules) = forall state. [Rule state] -> Rule state
Rules (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> (b -> a -> a) -> Rule b -> Rule a
subrule a -> b
getter b -> a -> a
setter) [Rule b]
rules)

rules :: [Rule state] -> Rule state
rules :: forall state. [Rule state] -> Rule state
rules = forall state. [Rule state] -> Rule state
Rules

applicationOf :: world -> [Rule world] -> IO ()
applicationOf :: forall world. world -> [Rule world] -> IO ()
applicationOf world
w [Rule world]
rules = forall world.
world -> (Event -> world -> world) -> (world -> Picture) -> IO ()
activityOf world
w Event -> world -> world
event world -> Picture
picture
  where
    event :: Event -> world -> world
event Event
ev = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id [Event -> world -> world
f Event
ev | Event -> world -> world
f <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Rule a -> [Event -> a -> a]
eventHandlers [Rule world]
rules]
    picture :: world -> Picture
picture world
w = HasCallStack => [Picture] -> Picture
pictures [world -> Picture
pic world
w | world -> Picture
pic <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Rule a -> [a -> Picture]
pictureHandlers [Rule world]
rules]
    eventHandlers :: Rule a -> [Event -> a -> a]
eventHandlers (EventRule Int -> Event -> a -> a
f) = [Int -> Event -> a -> a
f Int
0]
    eventHandlers (Rules [Rule a]
rs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Rule a -> [Event -> a -> a]
eventHandlers [Rule a]
rs
    eventHandlers Rule a
_ = []
    pictureHandlers :: Rule a -> [a -> Picture]
pictureHandlers (PictureRule Int -> a -> Picture
f) = [Int -> a -> Picture
f Int
0]
    pictureHandlers (Rules [Rule a]
rs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Rule a -> [a -> Picture]
pictureHandlers [Rule a]
rs
    pictureHandlers Rule a
_ = []

unsafeMultiApplicationOf :: Int -> (StdGen -> state) -> [Rule state] -> IO ()
unsafeMultiApplicationOf :: forall state. Int -> (StdGen -> state) -> [Rule state] -> IO ()
unsafeMultiApplicationOf Int
n StdGen -> state
initial [Rule state]
rules =
  forall world.
Int
-> (StdGen -> world)
-> (Int -> Event -> world -> world)
-> (Int -> world -> Picture)
-> IO ()
unsafeGroupActivityOf Int
n StdGen -> state
initial Int -> Event -> state -> state
event Int -> state -> Picture
picture
  where
    event :: Int -> Event -> state -> state
event Int
k Event
ev = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id [Int -> Event -> state -> state
f Int
k Event
ev | Int -> Event -> state -> state
f <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Rule a -> [Int -> Event -> a -> a]
eventHandlers [Rule state]
rules]
    picture :: Int -> state -> Picture
picture Int
k state
w = HasCallStack => [Picture] -> Picture
pictures [Int -> state -> Picture
pic Int
k state
w | Int -> state -> Picture
pic <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. Rule a -> [Int -> a -> Picture]
pictureHandlers [Rule state]
rules]
    eventHandlers :: Rule a -> [Int -> Event -> a -> a]
eventHandlers (EventRule Int -> Event -> a -> a
f) = [Int -> Event -> a -> a
f]
    eventHandlers (Rules [Rule a]
rs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Rule a -> [Int -> Event -> a -> a]
eventHandlers [Rule a]
rs
    eventHandlers Rule a
_ = []
    pictureHandlers :: Rule a -> [Int -> a -> Picture]
pictureHandlers (PictureRule Int -> a -> Picture
f) = [Int -> a -> Picture
f]
    pictureHandlers (Rules [Rule a]
rs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Rule a -> [Int -> a -> Picture]
pictureHandlers [Rule a]
rs
    pictureHandlers Rule a
_ = []