{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell    #-}

module Plots.Name where

import Control.Lens
-- import Data.Map            (Map)
import Data.Ord            (comparing)
import Data.Function
import Data.Typeable
import Diagrams.Core.Names
import Diagrams.Prelude    hiding (view)

data PlotName n = PlotName
  { forall n. PlotName n -> String
_plotName    :: String
  , forall n. PlotName n -> SizeSpec V2 n
_namedSize2D :: SizeSpec V2 n
  , forall n. PlotName n -> T2 n
_namedT2     :: T2 n
  } deriving Typeable

makeLenses ''PlotName

instance Show (PlotName n) where
  show :: PlotName n -> String
show PlotName n
pn = String
"Plot: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Getting String (PlotName n) String -> PlotName n -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String (PlotName n) String
forall n (f :: * -> *).
Functor f =>
(String -> f String) -> PlotName n -> f (PlotName n)
plotName PlotName n
pn

-- equating :: Eq b => (a -> b) -> a -> a -> Bool
-- equating = on (==)

instance Eq (PlotName n) where
  == :: PlotName n -> PlotName n -> Bool
(==) = (String -> String -> Bool)
-> (PlotName n -> String) -> PlotName n -> PlotName n -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Getting String (PlotName n) String -> PlotName n -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String (PlotName n) String
forall n (f :: * -> *).
Functor f =>
(String -> f String) -> PlotName n -> f (PlotName n)
plotName)

instance Ord (PlotName n) where
  compare :: PlotName n -> PlotName n -> Ordering
compare = (PlotName n -> String) -> PlotName n -> PlotName n -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Getting String (PlotName n) String -> PlotName n -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String (PlotName n) String
forall n (f :: * -> *).
Functor f =>
(String -> f String) -> PlotName n -> f (PlotName n)
plotName)

instance Typeable n => IsName (PlotName n)

-- _AName :: IsName a => Prism' AName a
-- _AName = prism' AName (\(AName a) -> cast a)

-- _Names :: IsName a => Traversal' Name a
-- _Names = _Wrapped' . traverse . _AName

-- _NamedString :: Traversal' Name String
-- _NamedString = _Names

-- _NamedPlot :: Typeable n => Traversal' Name (PlotName n)
-- _NamedPlot = _Names

-- diaNames :: OrderedField n => QDiagram b V2 n Any -> Map Name [P2 n]
-- diaNames = over (mapped . traversed) location . view (subMap . _Wrapped')