{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeFamilies          #-}
-- | @Pos@ is a general purpose wrapper for a specific positional value.
module Reflex.Dom.Widget.SVG.Types.Pos
  ( Pos
    -- * Empty types to separate coordinate spaces
  , X
  , Y
  , CenterX
  , CenterY
    -- * Prisms
  , _PosX
  , _PosY
  , _PosCenterX
  , _PosCenterY
    -- * Functions
  , changePosType
  , makePointsProp
  )
  where

import           Control.Lens                         (Iso', Rewrapped,
                                                       Wrapped (..), iso, (^.),
                                                       _Wrapped)

import           Data.Text                            (Text)

import           Data.Semigroup                       ((<>))

import           Data.List.NonEmpty                   (NonEmpty)

import           Reflex.Dom.Widget.SVG.Types.Internal (wrappedToText)

data X
data Y
data CenterX
data CenterY

-- | Wrap up the normal @Float@ value with a @newtype@ so that we can't mix
-- things up as easily. Include a phantom type so we're able to be granular
-- about the specific position we're interested in.
newtype Pos p =
  Pos Float
  deriving (Eq, Show)

instance (Pos p) ~ t => Rewrapped (Pos p) t

instance Wrapped (Pos p) where
  type Unwrapped (Pos p) = Float
  _Wrapped' = iso (\(Pos x) -> x) Pos

-- | Change the @Pos@ index type
changePosType :: Pos a -> Pos b
changePosType (Pos p) = Pos p

-- | Specific Iso for describing a X coordinate
_PosX :: Iso' (Pos X) Float
_PosX = _Wrapped

-- | Specific Iso for describing a Y coordinate
_PosY :: Iso' (Pos Y) Float
_PosY = _Wrapped

-- | Specific Iso for describing a centered X coordinate
_PosCenterX :: Iso' (Pos CenterX) Float
_PosCenterX = _Wrapped

-- | Specific Iso for describing a centered Y coordinate
_PosCenterY :: Iso' (Pos CenterY) Float
_PosCenterY = _Wrapped

-- | Convert the list of points to a correctly formatted list of X/Y positions
-- expected by SVG attributes.
makePointsProp
  :: NonEmpty (Pos X, Pos Y)
  -> Text
makePointsProp = foldMap
  (\(x,y) -> (x ^. wrappedToText) <> "," <> (y ^. wrappedToText) <> " ")