    {-# LANGUAGE DeriveDataTypeable         #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GADTs                      #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE TypeSynonymInstances       #-}

    {-# OPTIONS_GHC -fno-warn-unused-imports #-}
      -- for Data.Semigroup import, which becomes redundant under GHC 8.4

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Core.Names
    -- Copyright   :  (c) 2011-2015 diagrams-core team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- This module defines a type of names which can be used for referring
    -- to subdiagrams, and related types.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Core.Names
      (-- * Names
       -- ** Atomic names
        AName(..)
      , _AName

       -- ** Names
      , Name(..)
      , IsName(..)
      , (.>)
      , eachName

       -- ** Qualifiable
      , Qualifiable(..)

      ) where

    import           Control.Lens            hiding ((.>))
    import qualified Data.Map                as M
    import           Data.Semigroup
    import qualified Data.Set                as S
    import           Data.Typeable

    import           Diagrams.Core.Transform
    import           Diagrams.Core.Measure

    ------------------------------------------------------------
    --  Names  -------------------------------------------------
    ------------------------------------------------------------

    -- | Class for those types which can be used as names.  They must
    --   support 'Typeable' (to facilitate extracting them from
    --   existential wrappers), 'Ord' (for comparison and efficient
    --   storage) and 'Show'.
    --
    --   To make an instance of 'IsName', you need not define any methods,
    --   just declare it.
    --
    --   WARNING: it is not recommended to use
    --   @GeneralizedNewtypeDeriving@ in conjunction with @IsName@, since
    --   in that case the underlying type and the @newtype@ will be
    --   considered equivalent when comparing names.  For example:
    --
    --   @
    --     newtype WordN = WordN Int deriving (Show, Ord, Eq, Typeable, IsName)
    --   @
    --
    --   is unlikely to work as intended, since @(1 :: Int)@ and @(WordN 1)@
    --   will be considered equal as names.  Instead, use
    --
    --   @
    --     newtype WordN = WordN Int deriving (Show, Ord, Eq, Typeable, IsName)
    --     instance IsName WordN
    --   @
    class (Typeable a, Ord a, Show a) => IsName a where
      toName :: a -> Name
      toName = [AName] -> Name
    Name ([AName] -> Name) -> (a -> [AName]) -> a -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AName -> [AName] -> [AName]
    forall a. a -> [a] -> [a]
    :[]) (AName -> [AName]) -> (a -> AName) -> a -> [AName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> AName
    forall a. (Typeable a, Ord a, Show a) => a -> AName
    AName

    instance IsName ()
    instance IsName Bool
    instance IsName Char
    instance IsName Int
    instance IsName Float
    instance IsName Double
    instance IsName Integer
    instance IsName a => IsName [a]
    instance IsName a => IsName (Maybe a)
    instance (IsName a, IsName b) => IsName (a,b)
    instance (IsName a, IsName b, IsName c) => IsName (a,b,c)

    -- | Atomic names.  @AName@ is just an existential wrapper around
    --   things which are 'Typeable', 'Ord' and 'Show'.
    data AName where
      AName :: (Typeable a, Ord a, Show a) => a -> AName
      deriving Typeable

    instance IsName AName where
      toName :: AName -> Name
    toName = [AName] -> Name
    Name ([AName] -> Name) -> (AName -> [AName]) -> AName -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AName -> [AName] -> [AName]
    forall a. a -> [a] -> [a]
    :[])

    instance Eq AName where
      AName a
    a1 == :: AName -> AName -> Bool
    == AName a
    a2 =
        case a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    a2 of
          Maybe a
    Nothing  -> Bool
    False
          Just a
    a2' -> a
    a1 a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    a2'

    instance Ord AName where
      AName a
    a1 compare :: AName -> AName -> Ordering
    `compare` AName a
    a2 =
        case a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    a2 of
          Just a
    a2' -> a
    a1 a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` a
    a2'
          Maybe a
    Nothing  -> a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    a1 TypeRep -> TypeRep -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    a2

    instance Show AName where
      showsPrec :: Int -> AName -> ShowS
    showsPrec Int
    d (AName a
    a) = Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $
        String -> ShowS
    showString String
    "AName " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> a -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 a
    a

    -- | Prism onto 'AName'.
    _AName :: (Typeable a, Ord a, Show a) => Prism' AName a
    _AName :: forall a. (Typeable a, Ord a, Show a) => Prism' AName a
    _AName = (a -> AName) -> (AName -> Maybe a) -> Prism AName AName a a
    forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
    prism' a -> AName
    forall a. (Typeable a, Ord a, Show a) => a -> AName
    AName (\(AName a
    a) -> a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast a
    a)

    -- | A (qualified) name is a (possibly empty) sequence of atomic names.
    newtype Name = Name [AName]
      deriving (Name -> Name -> Bool
    (Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Name -> Name -> Bool
    == :: Name -> Name -> Bool
    $c/= :: Name -> Name -> Bool
    /= :: Name -> Name -> Bool
    Eq, Eq Name
    Eq Name =>
    (Name -> Name -> Ordering)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Bool)
    -> (Name -> Name -> Name)
    -> (Name -> Name -> Name)
    -> Ord Name
    Name -> Name -> Bool
    Name -> Name -> Ordering
    Name -> Name -> Name
    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
    $ccompare :: Name -> Name -> Ordering
    compare :: Name -> Name -> Ordering
    $c< :: Name -> Name -> Bool
    < :: Name -> Name -> Bool
    $c<= :: Name -> Name -> Bool
    <= :: Name -> Name -> Bool
    $c> :: Name -> Name -> Bool
    > :: Name -> Name -> Bool
    $c>= :: Name -> Name -> Bool
    >= :: Name -> Name -> Bool
    $cmax :: Name -> Name -> Name
    max :: Name -> Name -> Name
    $cmin :: Name -> Name -> Name
    min :: Name -> Name -> Name
    Ord, NonEmpty Name -> Name
    Name -> Name -> Name
    (Name -> Name -> Name)
    -> (NonEmpty Name -> Name)
    -> (forall b. Integral b => b -> Name -> Name)
    -> Semigroup Name
    forall b. Integral b => b -> Name -> Name
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    $c<> :: Name -> Name -> Name
    <> :: Name -> Name -> Name
    $csconcat :: NonEmpty Name -> Name
    sconcat :: NonEmpty Name -> Name
    $cstimes :: forall b. Integral b => b -> Name -> Name
    stimes :: forall b. Integral b => b -> Name -> Name
    Semigroup, Semigroup Name
    Name
    Semigroup Name =>
    Name -> (Name -> Name -> Name) -> ([Name] -> Name) -> Monoid Name
    [Name] -> Name
    Name -> Name -> Name
    forall a.
    Semigroup a =>
    a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
    $cmempty :: Name
    mempty :: Name
    $cmappend :: Name -> Name -> Name
    mappend :: Name -> Name -> Name
    $cmconcat :: [Name] -> Name
    mconcat :: [Name] -> Name
    Monoid, Typeable)

    instance Rewrapped Name Name
    instance Wrapped Name where
      type Unwrapped Name = [AName]
      _Wrapped' :: Iso' Name (Unwrapped Name)
    _Wrapped' = (Name -> [AName])
    -> ([AName] -> Name) -> Iso Name Name [AName] [AName]
    forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
    iso (\(Name [AName]
    ns) -> [AName]
    ns) [AName] -> Name
    Name

    instance Each Name Name AName AName where
      each :: Traversal Name Name AName AName
    each = ([AName] -> f [AName]) -> Name -> f Name
    (Unwrapped Name -> f (Unwrapped Name)) -> Name -> f Name
    forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
    Iso' Name (Unwrapped Name)
    _Wrapped (([AName] -> f [AName]) -> Name -> f Name)
    -> ((AName -> f AName) -> [AName] -> f [AName])
    -> (AName -> f AName)
    -> Name
    -> f Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AName -> f AName) -> [AName] -> f [AName]
    forall (f :: * -> *) a b.
    Traversable f =>
    IndexedTraversal Int (f a) (f b) a b
    IndexedTraversal Int [AName] [AName] AName AName
    traversed
      {-# INLINE each #-}

    -- | Traversal over each name in a 'Name' that matches the target type.
    --
    -- @
    -- >>> toListOf eachName ('a' .> False .> 'b') :: String
    -- "ab"
    -- >>> 'a' .> True .> 'b' & eachName %~ not
    -- 'a' .> False .> 'b'
    -- @
    --
    -- Note that the type of the name is very important.
    --
    -- @
    -- >>> sumOf eachName ((1::Int) .> (2 :: Integer) .> (3 :: Int)) :: Int
    -- 4
    -- >>> sumOf eachName ((1::Int) .> (2 :: Integer) .> (3 :: Int)) :: Integer
    -- 2
    -- @
    eachName :: (Typeable a, Ord a, Show a) => Traversal' Name a
    eachName :: forall a. (Typeable a, Ord a, Show a) => Traversal' Name a
    eachName = (AName -> f AName) -> Name -> f Name
    forall s t a b. Each s t a b => Traversal s t a b
    Traversal Name Name AName AName
    each ((AName -> f AName) -> Name -> f Name)
    -> ((a -> f a) -> AName -> f AName) -> (a -> f a) -> Name -> f Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> f a) -> AName -> f AName
    forall a. (Typeable a, Ord a, Show a) => Prism' AName a
    Prism' AName a
    _AName

    instance Show Name where
      showsPrec :: Int -> Name -> ShowS
    showsPrec Int
    d (Name [AName]
    xs) = case [AName]
    xs of
        []     -> Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    showString String
    "toName []"
        [AName
    n]    -> Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    showString String
    "toName " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> AName -> ShowS
    showsName Int
    11 AName
    n
        (AName
    n:[AName]
    ns) -> Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    5)  (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Int -> AName -> ShowS
    showsName Int
    6 AName
    n ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [AName] -> ShowS
    go [AName]
    ns
          where
            go :: [AName] -> ShowS
    go (AName
    y:[AName]
    ys) = String -> ShowS
    showString String
    " .> " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> AName -> ShowS
    showsName Int
    6 AName
    y ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [AName] -> ShowS
    go [AName]
    ys
            go [AName]
    _      = ShowS
    forall a. a -> a
    id
        where showsName :: Int -> AName -> ShowS
    showsName Int
    dd (AName a
    a) = Int -> a -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    dd a
    a

    instance IsName Name where
      toName :: Name -> Name
    toName = Name -> Name
    forall a. a -> a
    id

    -- | Convenient operator for writing qualified names with atomic
    --   components of different types.  Instead of writing @toName a1 \<\>
    --   toName a2 \<\> toName a3@ you can just write @a1 .> a2 .> a3@.
    (.>) :: (IsName a1, IsName a2) => a1 -> a2 -> Name
    a1
    a1 .> :: forall a1 a2. (IsName a1, IsName a2) => a1 -> a2 -> Name
    .> a2
    a2 = a1 -> Name
    forall a. IsName a => a -> Name
    toName a1
    a1 Name -> Name -> Name
    forall a. Semigroup a => a -> a -> a
    <> a2 -> Name
    forall a. IsName a => a -> Name
    toName a2
    a2

    -- | Instances of 'Qualifiable' are things which can be qualified by
    --   prefixing them with a name.
    class Qualifiable q where
      -- | Qualify with the given name.
      (.>>) :: IsName a => a -> q -> q

    -- | Of course, names can be qualified using @(.>)@.
    instance Qualifiable Name where
      .>> :: forall a. IsName a => a -> Name -> Name
    (.>>) = a -> Name -> Name
    forall a1 a2. (IsName a1, IsName a2) => a1 -> a2 -> Name
    (.>)

    instance Qualifiable a => Qualifiable (TransInv a) where
      .>> :: forall a. IsName a => a -> TransInv a -> TransInv a
    (.>>) a
    n = ASetter
      (TransInv a)
      (TransInv a)
      (TransInv (TransInv a))
      (TransInv (TransInv a))
    -> (TransInv (TransInv a) -> TransInv (TransInv a))
    -> TransInv a
    -> TransInv a
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ((Unwrapped (TransInv (TransInv a)) -> TransInv (TransInv a))
    -> Iso' (Unwrapped (TransInv (TransInv a))) (TransInv (TransInv a))
    forall s. Wrapped s => (Unwrapped s -> s) -> Iso' (Unwrapped s) s
    _Unwrapping' Unwrapped (TransInv (TransInv a)) -> TransInv (TransInv a)
    TransInv a -> TransInv (TransInv a)
    forall t. t -> TransInv t
    TransInv) (a
    n a -> TransInv (TransInv a) -> TransInv (TransInv a)
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a.
    IsName a =>
    a -> TransInv (TransInv a) -> TransInv (TransInv a)
    .>>)

    instance (Qualifiable a, Qualifiable b) => Qualifiable (a,b) where
      a
    n .>> :: forall a. IsName a => a -> (a, b) -> (a, b)
    .>> (a
    a,b
    b) = (a
    n a -> a -> a
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> a -> a
    .>> a
    a, a
    n a -> b -> b
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> b -> b
    .>> b
    b)

    instance (Qualifiable a, Qualifiable b, Qualifiable c) => Qualifiable (a,b,c) where
      a
    n .>> :: forall a. IsName a => a -> (a, b, c) -> (a, b, c)
    .>> (a
    a,b
    b,c
    c) = (a
    n a -> a -> a
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> a -> a
    .>> a
    a, a
    n a -> b -> b
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> b -> b
    .>> b
    b, a
    n a -> c -> c
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> c -> c
    .>> c
    c)

    instance Qualifiable a => Qualifiable [a] where
      a
    n .>> :: forall a. IsName a => a -> [a] -> [a]
    .>> [a]
    as = (a -> a) -> [a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (a
    n a -> a -> a
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> a -> a
    .>>) [a]
    as

    instance (Ord a, Qualifiable a) => Qualifiable (S.Set a) where
      a
    n .>> :: forall a. IsName a => a -> Set a -> Set a
    .>> Set a
    s = (a -> a) -> Set a -> Set a
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    S.map (a
    n a -> a -> a
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> a -> a
    .>>) Set a
    s

    instance Qualifiable a => Qualifiable (M.Map k a) where
      a
    n .>> :: forall a. IsName a => a -> Map k a -> Map k a
    .>> Map k a
    m = (a -> a) -> Map k a -> Map k a
    forall a b. (a -> b) -> Map k a -> Map k b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a
    n a -> a -> a
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> a -> a
    .>>) Map k a
    m

    instance Qualifiable a => Qualifiable (b -> a) where
      a
    n .>> :: forall a. IsName a => a -> (b -> a) -> b -> a
    .>> b -> a
    f = (a
    n a -> a -> a
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> a -> a
    .>>) (a -> a) -> (b -> a) -> b -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    f

    instance Qualifiable a => Qualifiable (Measured n a) where
      a
    n .>> :: forall a. IsName a => a -> Measured n a -> Measured n a
    .>> Measured n a
    m = (a -> a) -> Measured n a -> Measured n a
    forall a b. (a -> b) -> Measured n a -> Measured n b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a
    n a -> a -> a
    forall q a. (Qualifiable q, IsName a) => a -> q -> q
    forall a. IsName a => a -> a -> a
    .>>) Measured n a
    m

    infixr 5 .>>
    infixr 5 .>