module Test.DocTest.Location where

import Data.Traversable (Traversable, traverse)
import Data.Foldable (Foldable, foldMap)


-- | A thing with a location attached.
data Located pos a = Located pos a
  deriving (Located pos a -> Located pos a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall pos a.
(Eq pos, Eq a) =>
Located pos a -> Located pos a -> Bool
/= :: Located pos a -> Located pos a -> Bool
$c/= :: forall pos a.
(Eq pos, Eq a) =>
Located pos a -> Located pos a -> Bool
== :: Located pos a -> Located pos a -> Bool
$c== :: forall pos a.
(Eq pos, Eq a) =>
Located pos a -> Located pos a -> Bool
Eq, Int -> Located pos a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall pos a. (Show pos, Show a) => Int -> Located pos a -> ShowS
forall pos a. (Show pos, Show a) => [Located pos a] -> ShowS
forall pos a. (Show pos, Show a) => Located pos a -> String
showList :: [Located pos a] -> ShowS
$cshowList :: forall pos a. (Show pos, Show a) => [Located pos a] -> ShowS
show :: Located pos a -> String
$cshow :: forall pos a. (Show pos, Show a) => Located pos a -> String
showsPrec :: Int -> Located pos a -> ShowS
$cshowsPrec :: forall pos a. (Show pos, Show a) => Int -> Located pos a -> ShowS
Show)

instance Functor (Located pos) where
  fmap :: forall a b. (a -> b) -> Located pos a -> Located pos b
fmap a -> b
f (Located pos
loc a
a) = forall pos a. pos -> a -> Located pos a
Located pos
loc forall a b. (a -> b) -> a -> b
$ a -> b
f a
a

instance Foldable (Located pos) where
  foldMap :: forall m a. Monoid m => (a -> m) -> Located pos a -> m
foldMap a -> m
f (Located pos
_loc a
a) = a -> m
f a
a

instance Traversable (Located pos) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Located pos a -> f (Located pos b)
traverse a -> f b
f (Located pos
loc a
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall pos a. pos -> a -> Located pos a
Located pos
loc) forall a b. (a -> b) -> a -> b
$ a -> f b
f a
a


-- | Discard location information.
unLoc :: Located pos a -> a
unLoc :: forall pos a. Located pos a -> a
unLoc (Located pos
_ a
a) = a
a