{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Types and helper functions for working with directions
module Swarm.Language.Direction (
  -- * Directions
  Direction (..),
  AbsoluteDir (..),
  RelativeDir (..),
  PlanarRelativeDir (..),
  directionSyntax,
  isCardinal,
  allDirs,
) where

import Data.Aeson.Types hiding (Key)
import Data.Char qualified as C (toLower)
import Data.Data (Data)
import Data.Hashable (Hashable)
import Data.List qualified as L (tail)
import Data.Text hiding (filter, length, map)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Swarm.Util qualified as Util
import Witch.From (from)

------------------------------------------------------------
-- Directions
------------------------------------------------------------

-- | An absolute direction is one which is defined with respect to an
--   external frame of reference; robots need a compass in order to
--   use them.
--
-- NOTE: These values are ordered by increasing angle according to
-- the standard mathematical convention.
-- That is, the right-pointing direction, East, is considered
-- the "reference angle" and the order proceeds counter-clockwise.
-- See https://en.wikipedia.org/wiki/Polar_coordinate_system#Conventions
--
-- Do not alter this ordering, as there exist functions that depend on it
-- (e.g. 'Swarm.Game.Location.nearestDirection' and 'Swarm.Game.Location.relativeTo').
data AbsoluteDir = DEast | DNorth | DWest | DSouth
  deriving (AbsoluteDir -> AbsoluteDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsoluteDir -> AbsoluteDir -> Bool
$c/= :: AbsoluteDir -> AbsoluteDir -> Bool
== :: AbsoluteDir -> AbsoluteDir -> Bool
$c== :: AbsoluteDir -> AbsoluteDir -> Bool
Eq, Eq AbsoluteDir
AbsoluteDir -> AbsoluteDir -> Bool
AbsoluteDir -> AbsoluteDir -> Ordering
AbsoluteDir -> AbsoluteDir -> AbsoluteDir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AbsoluteDir -> AbsoluteDir -> AbsoluteDir
$cmin :: AbsoluteDir -> AbsoluteDir -> AbsoluteDir
max :: AbsoluteDir -> AbsoluteDir -> AbsoluteDir
$cmax :: AbsoluteDir -> AbsoluteDir -> AbsoluteDir
>= :: AbsoluteDir -> AbsoluteDir -> Bool
$c>= :: AbsoluteDir -> AbsoluteDir -> Bool
> :: AbsoluteDir -> AbsoluteDir -> Bool
$c> :: AbsoluteDir -> AbsoluteDir -> Bool
<= :: AbsoluteDir -> AbsoluteDir -> Bool
$c<= :: AbsoluteDir -> AbsoluteDir -> Bool
< :: AbsoluteDir -> AbsoluteDir -> Bool
$c< :: AbsoluteDir -> AbsoluteDir -> Bool
compare :: AbsoluteDir -> AbsoluteDir -> Ordering
$ccompare :: AbsoluteDir -> AbsoluteDir -> Ordering
Ord, Int -> AbsoluteDir -> ShowS
[AbsoluteDir] -> ShowS
AbsoluteDir -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsoluteDir] -> ShowS
$cshowList :: [AbsoluteDir] -> ShowS
show :: AbsoluteDir -> String
$cshow :: AbsoluteDir -> String
showsPrec :: Int -> AbsoluteDir -> ShowS
$cshowsPrec :: Int -> AbsoluteDir -> ShowS
Show, ReadPrec [AbsoluteDir]
ReadPrec AbsoluteDir
Int -> ReadS AbsoluteDir
ReadS [AbsoluteDir]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AbsoluteDir]
$creadListPrec :: ReadPrec [AbsoluteDir]
readPrec :: ReadPrec AbsoluteDir
$creadPrec :: ReadPrec AbsoluteDir
readList :: ReadS [AbsoluteDir]
$creadList :: ReadS [AbsoluteDir]
readsPrec :: Int -> ReadS AbsoluteDir
$creadsPrec :: Int -> ReadS AbsoluteDir
Read, forall x. Rep AbsoluteDir x -> AbsoluteDir
forall x. AbsoluteDir -> Rep AbsoluteDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbsoluteDir x -> AbsoluteDir
$cfrom :: forall x. AbsoluteDir -> Rep AbsoluteDir x
Generic, Typeable AbsoluteDir
AbsoluteDir -> DataType
AbsoluteDir -> Constr
(forall b. Data b => b -> b) -> AbsoluteDir -> AbsoluteDir
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AbsoluteDir -> u
forall u. (forall d. Data d => d -> u) -> AbsoluteDir -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbsoluteDir -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbsoluteDir -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbsoluteDir -> m AbsoluteDir
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsoluteDir -> m AbsoluteDir
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbsoluteDir
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbsoluteDir -> c AbsoluteDir
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbsoluteDir)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AbsoluteDir)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsoluteDir -> m AbsoluteDir
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsoluteDir -> m AbsoluteDir
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsoluteDir -> m AbsoluteDir
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AbsoluteDir -> m AbsoluteDir
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbsoluteDir -> m AbsoluteDir
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AbsoluteDir -> m AbsoluteDir
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AbsoluteDir -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AbsoluteDir -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AbsoluteDir -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AbsoluteDir -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbsoluteDir -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AbsoluteDir -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbsoluteDir -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AbsoluteDir -> r
gmapT :: (forall b. Data b => b -> b) -> AbsoluteDir -> AbsoluteDir
$cgmapT :: (forall b. Data b => b -> b) -> AbsoluteDir -> AbsoluteDir
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AbsoluteDir)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AbsoluteDir)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbsoluteDir)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AbsoluteDir)
dataTypeOf :: AbsoluteDir -> DataType
$cdataTypeOf :: AbsoluteDir -> DataType
toConstr :: AbsoluteDir -> Constr
$ctoConstr :: AbsoluteDir -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbsoluteDir
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AbsoluteDir
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbsoluteDir -> c AbsoluteDir
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AbsoluteDir -> c AbsoluteDir
Data, Eq AbsoluteDir
Int -> AbsoluteDir -> Int
AbsoluteDir -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: AbsoluteDir -> Int
$chash :: AbsoluteDir -> Int
hashWithSalt :: Int -> AbsoluteDir -> Int
$chashWithSalt :: Int -> AbsoluteDir -> Int
Hashable, Int -> AbsoluteDir
AbsoluteDir -> Int
AbsoluteDir -> [AbsoluteDir]
AbsoluteDir -> AbsoluteDir
AbsoluteDir -> AbsoluteDir -> [AbsoluteDir]
AbsoluteDir -> AbsoluteDir -> AbsoluteDir -> [AbsoluteDir]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AbsoluteDir -> AbsoluteDir -> AbsoluteDir -> [AbsoluteDir]
$cenumFromThenTo :: AbsoluteDir -> AbsoluteDir -> AbsoluteDir -> [AbsoluteDir]
enumFromTo :: AbsoluteDir -> AbsoluteDir -> [AbsoluteDir]
$cenumFromTo :: AbsoluteDir -> AbsoluteDir -> [AbsoluteDir]
enumFromThen :: AbsoluteDir -> AbsoluteDir -> [AbsoluteDir]
$cenumFromThen :: AbsoluteDir -> AbsoluteDir -> [AbsoluteDir]
enumFrom :: AbsoluteDir -> [AbsoluteDir]
$cenumFrom :: AbsoluteDir -> [AbsoluteDir]
fromEnum :: AbsoluteDir -> Int
$cfromEnum :: AbsoluteDir -> Int
toEnum :: Int -> AbsoluteDir
$ctoEnum :: Int -> AbsoluteDir
pred :: AbsoluteDir -> AbsoluteDir
$cpred :: AbsoluteDir -> AbsoluteDir
succ :: AbsoluteDir -> AbsoluteDir
$csucc :: AbsoluteDir -> AbsoluteDir
Enum, AbsoluteDir
forall a. a -> a -> Bounded a
maxBound :: AbsoluteDir
$cmaxBound :: AbsoluteDir
minBound :: AbsoluteDir
$cminBound :: AbsoluteDir
Bounded)

directionJsonModifier :: String -> String
directionJsonModifier :: ShowS
directionJsonModifier = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
C.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
L.tail

directionJsonOptions :: Options
directionJsonOptions :: Options
directionJsonOptions =
  Options
defaultOptions
    { constructorTagModifier :: ShowS
constructorTagModifier = ShowS
directionJsonModifier
    }

instance FromJSON AbsoluteDir where
  parseJSON :: Value -> Parser AbsoluteDir
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
directionJsonOptions

instance ToJSON AbsoluteDir where
  toJSON :: AbsoluteDir -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
directionJsonOptions

cardinalDirectionKeyOptions :: JSONKeyOptions
cardinalDirectionKeyOptions :: JSONKeyOptions
cardinalDirectionKeyOptions =
  JSONKeyOptions
defaultJSONKeyOptions
    { keyModifier :: ShowS
keyModifier = ShowS
directionJsonModifier
    }

instance ToJSONKey AbsoluteDir where
  toJSONKey :: ToJSONKeyFunction AbsoluteDir
toJSONKey = forall a.
(Generic a, GToJSONKey (Rep a)) =>
JSONKeyOptions -> ToJSONKeyFunction a
genericToJSONKey JSONKeyOptions
cardinalDirectionKeyOptions

instance FromJSONKey AbsoluteDir where
  fromJSONKey :: FromJSONKeyFunction AbsoluteDir
fromJSONKey = forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
cardinalDirectionKeyOptions

-- | A relative direction is one which is defined with respect to the
--   robot's frame of reference; no special capability is needed to
--   use them.
data RelativeDir = DPlanar PlanarRelativeDir | DDown
  deriving (RelativeDir -> RelativeDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelativeDir -> RelativeDir -> Bool
$c/= :: RelativeDir -> RelativeDir -> Bool
== :: RelativeDir -> RelativeDir -> Bool
$c== :: RelativeDir -> RelativeDir -> Bool
Eq, Eq RelativeDir
RelativeDir -> RelativeDir -> Bool
RelativeDir -> RelativeDir -> Ordering
RelativeDir -> RelativeDir -> RelativeDir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RelativeDir -> RelativeDir -> RelativeDir
$cmin :: RelativeDir -> RelativeDir -> RelativeDir
max :: RelativeDir -> RelativeDir -> RelativeDir
$cmax :: RelativeDir -> RelativeDir -> RelativeDir
>= :: RelativeDir -> RelativeDir -> Bool
$c>= :: RelativeDir -> RelativeDir -> Bool
> :: RelativeDir -> RelativeDir -> Bool
$c> :: RelativeDir -> RelativeDir -> Bool
<= :: RelativeDir -> RelativeDir -> Bool
$c<= :: RelativeDir -> RelativeDir -> Bool
< :: RelativeDir -> RelativeDir -> Bool
$c< :: RelativeDir -> RelativeDir -> Bool
compare :: RelativeDir -> RelativeDir -> Ordering
$ccompare :: RelativeDir -> RelativeDir -> Ordering
Ord, Int -> RelativeDir -> ShowS
[RelativeDir] -> ShowS
RelativeDir -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelativeDir] -> ShowS
$cshowList :: [RelativeDir] -> ShowS
show :: RelativeDir -> String
$cshow :: RelativeDir -> String
showsPrec :: Int -> RelativeDir -> ShowS
$cshowsPrec :: Int -> RelativeDir -> ShowS
Show, ReadPrec [RelativeDir]
ReadPrec RelativeDir
Int -> ReadS RelativeDir
ReadS [RelativeDir]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RelativeDir]
$creadListPrec :: ReadPrec [RelativeDir]
readPrec :: ReadPrec RelativeDir
$creadPrec :: ReadPrec RelativeDir
readList :: ReadS [RelativeDir]
$creadList :: ReadS [RelativeDir]
readsPrec :: Int -> ReadS RelativeDir
$creadsPrec :: Int -> ReadS RelativeDir
Read, forall x. Rep RelativeDir x -> RelativeDir
forall x. RelativeDir -> Rep RelativeDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RelativeDir x -> RelativeDir
$cfrom :: forall x. RelativeDir -> Rep RelativeDir x
Generic, Typeable RelativeDir
RelativeDir -> DataType
RelativeDir -> Constr
(forall b. Data b => b -> b) -> RelativeDir -> RelativeDir
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RelativeDir -> u
forall u. (forall d. Data d => d -> u) -> RelativeDir -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RelativeDir -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RelativeDir -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RelativeDir -> m RelativeDir
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelativeDir -> m RelativeDir
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelativeDir
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelativeDir -> c RelativeDir
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RelativeDir)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RelativeDir)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelativeDir -> m RelativeDir
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelativeDir -> m RelativeDir
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelativeDir -> m RelativeDir
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RelativeDir -> m RelativeDir
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RelativeDir -> m RelativeDir
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RelativeDir -> m RelativeDir
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RelativeDir -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RelativeDir -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RelativeDir -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RelativeDir -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RelativeDir -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RelativeDir -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RelativeDir -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RelativeDir -> r
gmapT :: (forall b. Data b => b -> b) -> RelativeDir -> RelativeDir
$cgmapT :: (forall b. Data b => b -> b) -> RelativeDir -> RelativeDir
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RelativeDir)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RelativeDir)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RelativeDir)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RelativeDir)
dataTypeOf :: RelativeDir -> DataType
$cdataTypeOf :: RelativeDir -> DataType
toConstr :: RelativeDir -> Constr
$ctoConstr :: RelativeDir -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelativeDir
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RelativeDir
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelativeDir -> c RelativeDir
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RelativeDir -> c RelativeDir
Data, Eq RelativeDir
Int -> RelativeDir -> Int
RelativeDir -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: RelativeDir -> Int
$chash :: RelativeDir -> Int
hashWithSalt :: Int -> RelativeDir -> Int
$chashWithSalt :: Int -> RelativeDir -> Int
Hashable, [RelativeDir] -> Encoding
[RelativeDir] -> Value
RelativeDir -> Encoding
RelativeDir -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RelativeDir] -> Encoding
$ctoEncodingList :: [RelativeDir] -> Encoding
toJSONList :: [RelativeDir] -> Value
$ctoJSONList :: [RelativeDir] -> Value
toEncoding :: RelativeDir -> Encoding
$ctoEncoding :: RelativeDir -> Encoding
toJSON :: RelativeDir -> Value
$ctoJSON :: RelativeDir -> Value
ToJSON, Value -> Parser [RelativeDir]
Value -> Parser RelativeDir
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RelativeDir]
$cparseJSONList :: Value -> Parser [RelativeDir]
parseJSON :: Value -> Parser RelativeDir
$cparseJSON :: Value -> Parser RelativeDir
FromJSON)

-- | Caution: Do not alter this ordering, as there exist functions that depend on it
-- (e.g. 'Swarm.Game.Location.nearestDirection' and 'Swarm.Game.Location.relativeTo').
data PlanarRelativeDir = DForward | DLeft | DBack | DRight
  deriving (PlanarRelativeDir -> PlanarRelativeDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
$c/= :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
== :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
$c== :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
Eq, Eq PlanarRelativeDir
PlanarRelativeDir -> PlanarRelativeDir -> Bool
PlanarRelativeDir -> PlanarRelativeDir -> Ordering
PlanarRelativeDir -> PlanarRelativeDir -> PlanarRelativeDir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PlanarRelativeDir -> PlanarRelativeDir -> PlanarRelativeDir
$cmin :: PlanarRelativeDir -> PlanarRelativeDir -> PlanarRelativeDir
max :: PlanarRelativeDir -> PlanarRelativeDir -> PlanarRelativeDir
$cmax :: PlanarRelativeDir -> PlanarRelativeDir -> PlanarRelativeDir
>= :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
$c>= :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
> :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
$c> :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
<= :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
$c<= :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
< :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
$c< :: PlanarRelativeDir -> PlanarRelativeDir -> Bool
compare :: PlanarRelativeDir -> PlanarRelativeDir -> Ordering
$ccompare :: PlanarRelativeDir -> PlanarRelativeDir -> Ordering
Ord, Int -> PlanarRelativeDir -> ShowS
[PlanarRelativeDir] -> ShowS
PlanarRelativeDir -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlanarRelativeDir] -> ShowS
$cshowList :: [PlanarRelativeDir] -> ShowS
show :: PlanarRelativeDir -> String
$cshow :: PlanarRelativeDir -> String
showsPrec :: Int -> PlanarRelativeDir -> ShowS
$cshowsPrec :: Int -> PlanarRelativeDir -> ShowS
Show, ReadPrec [PlanarRelativeDir]
ReadPrec PlanarRelativeDir
Int -> ReadS PlanarRelativeDir
ReadS [PlanarRelativeDir]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PlanarRelativeDir]
$creadListPrec :: ReadPrec [PlanarRelativeDir]
readPrec :: ReadPrec PlanarRelativeDir
$creadPrec :: ReadPrec PlanarRelativeDir
readList :: ReadS [PlanarRelativeDir]
$creadList :: ReadS [PlanarRelativeDir]
readsPrec :: Int -> ReadS PlanarRelativeDir
$creadsPrec :: Int -> ReadS PlanarRelativeDir
Read, forall x. Rep PlanarRelativeDir x -> PlanarRelativeDir
forall x. PlanarRelativeDir -> Rep PlanarRelativeDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlanarRelativeDir x -> PlanarRelativeDir
$cfrom :: forall x. PlanarRelativeDir -> Rep PlanarRelativeDir x
Generic, Typeable PlanarRelativeDir
PlanarRelativeDir -> DataType
PlanarRelativeDir -> Constr
(forall b. Data b => b -> b)
-> PlanarRelativeDir -> PlanarRelativeDir
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PlanarRelativeDir -> u
forall u. (forall d. Data d => d -> u) -> PlanarRelativeDir -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlanarRelativeDir -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlanarRelativeDir -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PlanarRelativeDir -> m PlanarRelativeDir
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PlanarRelativeDir -> m PlanarRelativeDir
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanarRelativeDir
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanarRelativeDir -> c PlanarRelativeDir
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanarRelativeDir)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlanarRelativeDir)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PlanarRelativeDir -> m PlanarRelativeDir
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PlanarRelativeDir -> m PlanarRelativeDir
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PlanarRelativeDir -> m PlanarRelativeDir
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PlanarRelativeDir -> m PlanarRelativeDir
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PlanarRelativeDir -> m PlanarRelativeDir
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PlanarRelativeDir -> m PlanarRelativeDir
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PlanarRelativeDir -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PlanarRelativeDir -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PlanarRelativeDir -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PlanarRelativeDir -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlanarRelativeDir -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlanarRelativeDir -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlanarRelativeDir -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlanarRelativeDir -> r
gmapT :: (forall b. Data b => b -> b)
-> PlanarRelativeDir -> PlanarRelativeDir
$cgmapT :: (forall b. Data b => b -> b)
-> PlanarRelativeDir -> PlanarRelativeDir
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlanarRelativeDir)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PlanarRelativeDir)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanarRelativeDir)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlanarRelativeDir)
dataTypeOf :: PlanarRelativeDir -> DataType
$cdataTypeOf :: PlanarRelativeDir -> DataType
toConstr :: PlanarRelativeDir -> Constr
$ctoConstr :: PlanarRelativeDir -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanarRelativeDir
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlanarRelativeDir
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanarRelativeDir -> c PlanarRelativeDir
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlanarRelativeDir -> c PlanarRelativeDir
Data, Eq PlanarRelativeDir
Int -> PlanarRelativeDir -> Int
PlanarRelativeDir -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PlanarRelativeDir -> Int
$chash :: PlanarRelativeDir -> Int
hashWithSalt :: Int -> PlanarRelativeDir -> Int
$chashWithSalt :: Int -> PlanarRelativeDir -> Int
Hashable, Int -> PlanarRelativeDir
PlanarRelativeDir -> Int
PlanarRelativeDir -> [PlanarRelativeDir]
PlanarRelativeDir -> PlanarRelativeDir
PlanarRelativeDir -> PlanarRelativeDir -> [PlanarRelativeDir]
PlanarRelativeDir
-> PlanarRelativeDir -> PlanarRelativeDir -> [PlanarRelativeDir]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PlanarRelativeDir
-> PlanarRelativeDir -> PlanarRelativeDir -> [PlanarRelativeDir]
$cenumFromThenTo :: PlanarRelativeDir
-> PlanarRelativeDir -> PlanarRelativeDir -> [PlanarRelativeDir]
enumFromTo :: PlanarRelativeDir -> PlanarRelativeDir -> [PlanarRelativeDir]
$cenumFromTo :: PlanarRelativeDir -> PlanarRelativeDir -> [PlanarRelativeDir]
enumFromThen :: PlanarRelativeDir -> PlanarRelativeDir -> [PlanarRelativeDir]
$cenumFromThen :: PlanarRelativeDir -> PlanarRelativeDir -> [PlanarRelativeDir]
enumFrom :: PlanarRelativeDir -> [PlanarRelativeDir]
$cenumFrom :: PlanarRelativeDir -> [PlanarRelativeDir]
fromEnum :: PlanarRelativeDir -> Int
$cfromEnum :: PlanarRelativeDir -> Int
toEnum :: Int -> PlanarRelativeDir
$ctoEnum :: Int -> PlanarRelativeDir
pred :: PlanarRelativeDir -> PlanarRelativeDir
$cpred :: PlanarRelativeDir -> PlanarRelativeDir
succ :: PlanarRelativeDir -> PlanarRelativeDir
$csucc :: PlanarRelativeDir -> PlanarRelativeDir
Enum, PlanarRelativeDir
forall a. a -> a -> Bounded a
maxBound :: PlanarRelativeDir
$cmaxBound :: PlanarRelativeDir
minBound :: PlanarRelativeDir
$cminBound :: PlanarRelativeDir
Bounded)

instance FromJSON PlanarRelativeDir where
  parseJSON :: Value -> Parser PlanarRelativeDir
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
directionJsonOptions

instance ToJSON PlanarRelativeDir where
  toJSON :: PlanarRelativeDir -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
directionJsonOptions

-- | The type of directions. Used /e.g./ to indicate which way a robot
--   will turn.
data Direction = DAbsolute AbsoluteDir | DRelative RelativeDir
  deriving (Direction -> Direction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Eq Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
Ord, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Direction]
$creadListPrec :: ReadPrec [Direction]
readPrec :: ReadPrec Direction
$creadPrec :: ReadPrec Direction
readList :: ReadS [Direction]
$creadList :: ReadS [Direction]
readsPrec :: Int -> ReadS Direction
$creadsPrec :: Int -> ReadS Direction
Read, forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Direction x -> Direction
$cfrom :: forall x. Direction -> Rep Direction x
Generic, Typeable Direction
Direction -> DataType
Direction -> Constr
(forall b. Data b => b -> b) -> Direction -> Direction
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
forall u. (forall d. Data d => d -> u) -> Direction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Direction -> m Direction
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Direction -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Direction -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Direction -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Direction -> r
gmapT :: (forall b. Data b => b -> b) -> Direction -> Direction
$cgmapT :: (forall b. Data b => b -> b) -> Direction -> Direction
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Direction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Direction)
dataTypeOf :: Direction -> DataType
$cdataTypeOf :: Direction -> DataType
toConstr :: Direction -> Constr
$ctoConstr :: Direction -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Direction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Direction -> c Direction
Data, Eq Direction
Int -> Direction -> Int
Direction -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Direction -> Int
$chash :: Direction -> Int
hashWithSalt :: Int -> Direction -> Int
$chashWithSalt :: Int -> Direction -> Int
Hashable, [Direction] -> Encoding
[Direction] -> Value
Direction -> Encoding
Direction -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Direction] -> Encoding
$ctoEncodingList :: [Direction] -> Encoding
toJSONList :: [Direction] -> Value
$ctoJSONList :: [Direction] -> Value
toEncoding :: Direction -> Encoding
$ctoEncoding :: Direction -> Encoding
toJSON :: Direction -> Value
$ctoJSON :: Direction -> Value
ToJSON, Value -> Parser [Direction]
Value -> Parser Direction
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Direction]
$cparseJSONList :: Value -> Parser [Direction]
parseJSON :: Value -> Parser Direction
$cparseJSON :: Value -> Parser Direction
FromJSON)

-- | Direction name is generated from the deepest nested data constructor
-- e.g. 'DLeft' becomes "left"
directionSyntax :: Direction -> Text
directionSyntax :: Direction -> Text
directionSyntax Direction
d = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from forall a b. (a -> b) -> a -> b
$ case Direction
d of
  DAbsolute AbsoluteDir
x -> forall a. Show a => a -> String
show AbsoluteDir
x
  DRelative RelativeDir
x -> case RelativeDir
x of
    DPlanar PlanarRelativeDir
y -> forall a. Show a => a -> String
show PlanarRelativeDir
y
    RelativeDir
_ -> forall a. Show a => a -> String
show RelativeDir
x

-- | Check if the direction is absolute (e.g. 'Swarm.Game.Location.north' or 'Swarm.Game.Location.south').
isCardinal :: Direction -> Bool
isCardinal :: Direction -> Bool
isCardinal = \case
  DAbsolute AbsoluteDir
_ -> Bool
True
  Direction
_ -> Bool
False

allDirs :: [Direction]
allDirs :: [Direction]
allDirs = forall a b. (a -> b) -> [a] -> [b]
map AbsoluteDir -> Direction
DAbsolute forall e. (Enum e, Bounded e) => [e]
Util.listEnums forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map RelativeDir -> Direction
DRelative (RelativeDir
DDown forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map PlanarRelativeDir -> RelativeDir
DPlanar forall e. (Enum e, Bounded e) => [e]
Util.listEnums)