{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
module Data.Annotation
( module Data.Annotation
, module Data.Proxy
) where
import Data.Either
import Data.Maybe
import Data.Proxy
import Data.Set (Set)
import qualified Data.Set as Set
import Data.String
import qualified Data.Text as Text
import Data.Typeable
import GHC.Stack
type AnnC a = (Typeable a, Show a)
data Annotation where
Annotation
:: AnnC a
=> a
-> Annotation
instance Show Annotation where
showsPrec :: Int -> Annotation -> ShowS
showsPrec Int
p (Annotation a
a) =
Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Annotation @"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (forall a. Typeable a => a -> TypeRep
typeOf a
a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a
instance IsString Annotation where
fromString :: String -> Annotation
fromString = forall a. AnnC a => a -> Annotation
Annotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
toAnnotation :: (AnnC a) => a -> Annotation
toAnnotation :: forall a. AnnC a => a -> Annotation
toAnnotation = forall a. AnnC a => a -> Annotation
Annotation
castAnnotation
:: forall a. (Typeable a)
=> Annotation
-> Maybe a
castAnnotation :: forall a. Typeable a => Annotation -> Maybe a
castAnnotation (Annotation a
ann) =
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
ann
tryAnnotation
:: forall a. (Typeable a)
=> Annotation
-> Either a Annotation
tryAnnotation :: forall a. Typeable a => Annotation -> Either a Annotation
tryAnnotation a :: Annotation
a@(Annotation a
val) =
case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
val of
Just a
x ->
forall a b. a -> Either a b
Left a
x
Maybe a
Nothing ->
forall a b. b -> Either a b
Right Annotation
a
tryAnnotations
:: forall a. (Typeable a)
=> [Annotation]
-> ([a], [Annotation])
tryAnnotations :: forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Typeable a => Annotation -> Either a Annotation
tryAnnotation
annotationTypes
:: [Annotation]
-> Set TypeRep
annotationTypes :: [Annotation] -> Set TypeRep
annotationTypes = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Annotation a
a) -> forall a. Typeable a => a -> TypeRep
typeOf a
a)
mapAnnotation
:: ((AnnC a, AnnC b))
=> (a -> b)
-> Annotation
-> Maybe Annotation
mapAnnotation :: forall a b.
(AnnC a, AnnC b) =>
(a -> b) -> Annotation -> Maybe Annotation
mapAnnotation a -> b
f (Annotation a
ann) =
forall a. AnnC a => a -> Annotation
Annotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
ann
mapMaybeAnnotation
:: (AnnC a, AnnC b)
=> (a -> b)
-> Annotation
-> Annotation
mapMaybeAnnotation :: forall a b.
(AnnC a, AnnC b) =>
(a -> b) -> Annotation -> Annotation
mapMaybeAnnotation a -> b
f Annotation
ann =
forall a. a -> Maybe a -> a
fromMaybe Annotation
ann (forall a b.
(AnnC a, AnnC b) =>
(a -> b) -> Annotation -> Maybe Annotation
mapAnnotation a -> b
f Annotation
ann)
newtype CallStackAnnotation = CallStackAnnotation
{ CallStackAnnotation -> [(String, SrcLoc)]
unCallStackAnnotation :: [(String, SrcLoc)]
}
deriving (CallStackAnnotation -> CallStackAnnotation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallStackAnnotation -> CallStackAnnotation -> Bool
$c/= :: CallStackAnnotation -> CallStackAnnotation -> Bool
== :: CallStackAnnotation -> CallStackAnnotation -> Bool
$c== :: CallStackAnnotation -> CallStackAnnotation -> Bool
Eq, Int -> CallStackAnnotation -> ShowS
[CallStackAnnotation] -> ShowS
CallStackAnnotation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CallStackAnnotation] -> ShowS
$cshowList :: [CallStackAnnotation] -> ShowS
show :: CallStackAnnotation -> String
$cshow :: CallStackAnnotation -> String
showsPrec :: Int -> CallStackAnnotation -> ShowS
$cshowsPrec :: Int -> CallStackAnnotation -> ShowS
Show)
{-# DEPRECATED CallStackAnnotation "You can just use `CallStack` directly now." #-}
callStackAnnotation :: HasCallStack => Annotation
callStackAnnotation :: HasCallStack => Annotation
callStackAnnotation = forall a. AnnC a => a -> Annotation
Annotation HasCallStack => CallStack
callStack
callStackToAnnotation :: CallStack -> Annotation
callStackToAnnotation :: CallStack -> Annotation
callStackToAnnotation = forall a. AnnC a => a -> Annotation
Annotation
callStackFromAnnotation :: CallStackAnnotation -> CallStack
callStackFromAnnotation :: CallStackAnnotation -> CallStack
callStackFromAnnotation CallStackAnnotation
ann =
[(String, SrcLoc)] -> CallStack
fromCallSiteList forall a b. (a -> b) -> a -> b
$ CallStackAnnotation -> [(String, SrcLoc)]
unCallStackAnnotation CallStackAnnotation
ann
{-# DEPRECATED callStackFromAnnotation "You can use 'CallStack' directly in annotations as of 0.2.0.0." #-}
callStackInAnnotations :: [Annotation] -> ([CallStack], [Annotation])
callStackInAnnotations :: [Annotation] -> ([CallStack], [Annotation])
callStackInAnnotations =
forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations
{-# DEPRECATED callStackInAnnotations "You can just use 'tryAnnotations' directly as of 0.2.0.0." #-}