module Skeletest.Internal.Markers (
  IsMarker (..),
  AnonMarker (..),
  SomeMarker (..),
  findMarker,
  hasMarkerNamed,
) where

import Data.Maybe (listToMaybe, mapMaybe)
import Data.Typeable (Typeable, cast)

class (Show a, Typeable a) => IsMarker a where
  -- | The name of the marker that can be selected with @@name@ syntax.
  --
  -- Marker names must only include alphanumeric characters, hyphens,
  -- underscores, and periods.
  getMarkerName :: a -> String

-- | A marker that can be used for bespoke marker definitions.
newtype AnonMarker = AnonMarker String
  deriving (Int -> AnonMarker -> ShowS
[AnonMarker] -> ShowS
AnonMarker -> String
(Int -> AnonMarker -> ShowS)
-> (AnonMarker -> String)
-> ([AnonMarker] -> ShowS)
-> Show AnonMarker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnonMarker -> ShowS
showsPrec :: Int -> AnonMarker -> ShowS
$cshow :: AnonMarker -> String
show :: AnonMarker -> String
$cshowList :: [AnonMarker] -> ShowS
showList :: [AnonMarker] -> ShowS
Show)

instance IsMarker AnonMarker where
  getMarkerName :: AnonMarker -> String
getMarkerName (AnonMarker String
name) = String
name

data SomeMarker = forall a. (IsMarker a) => SomeMarker a

deriving instance Show SomeMarker

-- | Find the first marker in the given list with the given type.
findMarker :: forall a. (IsMarker a) => [SomeMarker] -> Maybe a
findMarker :: forall a. IsMarker a => [SomeMarker] -> Maybe a
findMarker = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a)
-> ([SomeMarker] -> [a]) -> [SomeMarker] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeMarker -> Maybe a) -> [SomeMarker] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(SomeMarker a
m) -> a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
m)

-- | Return true if the given marker name is present.
hasMarkerNamed :: String -> [SomeMarker] -> Bool
hasMarkerNamed :: String -> [SomeMarker] -> Bool
hasMarkerNamed String
name = (SomeMarker -> Bool) -> [SomeMarker] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(SomeMarker a
m) -> a -> String
forall a. IsMarker a => a -> String
getMarkerName a
m String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name)