    {-# LANGUAGE CPP                        #-}
    {-# LANGUAGE DeriveDataTypeable         #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE UndecidableInstances       #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.TwoD.Text
    -- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Very basic text primitives along with associated attributes.
    --
    -----------------------------------------------------------------------------

    module Diagrams.TwoD.Text (
      -- * Creating text diagrams
        Text(..), TextAlignment(..)
      , text, topLeftText, alignedText, baselineText
      , mkText, mkText'

      -- * Text attributes

      -- ** Font family
      , Font(..), _Font
      , getFont, font, _font

      -- ** Font size
      , FontSize(..), _FontSize
      , fontSize, recommendFontSize
      , fontSizeN, fontSizeO, fontSizeL, fontSizeG
      , getFontSize, fontSizeM
      , _fontSizeR, _fontSize, _fontSizeU

      -- ** Font slant
      , FontSlant(..)
      , getFontSlant, fontSlant, italic, oblique, _fontSlant

      -- ** Font weight
      , FontWeight(..)
      , getFontWeight, fontWeight, bold, bolder, lighter, _fontWeight
      , thinWeight, ultraLight, light, mediumWeight, heavy, semiBold, ultraBold

      ) where

    import           Control.Lens             hiding (transform)
    import           Diagrams.Attributes      (committed)
    import           Diagrams.Core
    import           Diagrams.Core.Envelope   (pointEnvelope)
    import           Diagrams.TwoD.Attributes (recommendFillColor)
    import           Diagrams.TwoD.Types

    import           Data.Colour              hiding (over)
    import           Data.Default.Class
    #if __GLASGOW_HASKELL__ < 710
    import           Data.Functor
    #endif
    import           Data.Monoid.Recommend
    import           Data.Semigroup
    import           Data.Typeable

    import           Linear.Affine

    ------------------------------------------------------------
    -- Text diagrams
    ------------------------------------------------------------

    -- | A 'Text' primitive consists of the string contents, text alignment
    --   and the transformation to be applied. The transformation is scale
    --   invarient, the average scale of the transform should always be 1.
    --   All text scaling is obtained from the 'FontSize' attribute.
    --
    --   This constructor should not be used directly. Use 'text',
    --   'alignedText' or 'baselineText'.
    data Text n = Text (T2 n) (TextAlignment n) String
      deriving Typeable

    type instance V (Text n) = V2
    type instance N (Text n) = n

    instance Floating n => Transformable (Text n) where
      transform t (Text tt a s) = Text (t <> tt <> t') a s
        where t' = scaling (1 / avgScale t)

    instance Floating n => HasOrigin (Text n) where
      moveOriginTo p = translate (origin .-. p)

    instance Floating n => Renderable (Text n) NullBackend where
      render _ _ = mempty

    -- | @TextAlignment@ specifies the alignment of the text's origin.
    data TextAlignment n = BaselineText | BoxAlignedText n n

    -- | Make a text from a 'TextAlignment', recommending a fill colour of
    --   'black' and 'fontSize' of @'local' 1@.
    mkText :: (TypeableFloat n, Renderable (Text n) b)
      => TextAlignment n -> String -> QDiagram b V2 n Any
    mkText a = recommendFillColor black
               -- See Note [recommendFillColor]
             . recommendFontSize (local 1)
               -- See Note [recommendFontSize]
             . mkText' a

    -- | Make a text from a 'TextAlignment' without any default size or fill
    --   colour. This is useful is you want to recommend your own using
    --   'recommendFillColor' or 'recommendFontSize'.
    mkText' :: (TypeableFloat n, Renderable (Text n) b)
      => TextAlignment n -> String -> QDiagram b V2 n Any
    mkText' a t = mkQD (Prim $ Text mempty a t)
                       (pointEnvelope origin)
                       mempty
                       mempty
                       mempty

    -- ~~~~ Note [recommendFillColor]

    -- The reason we "recommend" a fill color of black instead of setting
    -- it directly (or instead of simply not specifying a fill color at
    -- all) was originally to support the SVG backend, though it is
    -- actually in some sense the "right thing" to do, and other backends
    -- we add later may conceivably need it as well.  The cairo backend
    -- defaults happen to be to use a transparent fill for paths and a
    -- black fill for text.  The SVG standard, however, specifies a
    -- default fill of black for everything (both text and paths).  In
    -- order to correctly render paths with no fill set, the SVG backend
    -- must therefore explicitly set the fill to transparent -- but this
    -- meant that it was also drawing text with a transparent fill.  The
    -- solution is that we now explicitly inform all backends that the
    -- *default* ("recommended") fill color for text should be black; an
    -- absence of fill specification now consistently means to use a
    -- "transparent" fill no matter what the primitive.  The reason we
    -- need the special recommend/commit distinction is because if the
    -- user explicitly sets a fill color later it should override this
    -- recommendation; normally, the innermost occurrence of an attribute
    -- would override all outer occurrences.

    -- ~~~~ Note [recommendFontSize]
    -- The reason we "recommend" a font size is so any local scales get
    -- recorded.

    -- | Create a primitive text diagram from the given string, with center
    --   alignment, equivalent to @'alignedText' 0.5 0.5@.
    --
    --   Note that it /takes up no space/, as text size information is not
    --   available.
    text :: (TypeableFloat n, Renderable (Text n) b) => String -> QDiagram b V2 n Any
    text = alignedText 0.5 0.5

    -- | Create a primitive text diagram from the given string, origin at
    --   the top left corner of the text's bounding box, equivalent to
    --   @'alignedText' 0 1@.
    --
    --   Note that it /takes up no space/.
    topLeftText :: (TypeableFloat n, Renderable (Text n) b) => String -> QDiagram b V2 n Any
    topLeftText = alignedText 0 1

    -- | Create a primitive text diagram from the given string, with the
    --   origin set to a point interpolated within the bounding box.  The
    --   first parameter varies from 0 (left) to 1 (right), and the second
    --   parameter from 0 (bottom) to 1 (top). Some backends do not
    --   implement this and instead snap to closest corner or the center.
    --
    --   The height of this box is determined by the font's potential ascent
    --   and descent, rather than the height of the particular string.
    --
    --   Note that it /takes up no space/.
    alignedText :: (TypeableFloat n, Renderable (Text n) b)
      => n -> n -> String -> QDiagram b V2 n Any
    alignedText w h = mkText (BoxAlignedText w h)

    -- | Create a primitive text diagram from the given string, with the
    --   origin set to be on the baseline, at the beginning (although not
    --   bounding).  This is the reference point of showText in the Cairo
    --   graphics library.
    --
    --   Note that it /takes up no space/.
    baselineText :: (TypeableFloat n, Renderable (Text n) b)
      => String -> QDiagram b V2 n Any
    baselineText = mkText BaselineText

    ------------------------------------------------------------
    -- Text attributes
    ------------------------------------------------------------

    --------------------------------------------------
    -- Font family

    -- | The @Font@ attribute specifies the name of a font family.  Inner
    --   @Font@ attributes override outer ones.
    newtype Font = Font (Last String)
      deriving (Typeable, Semigroup, Eq)

    _Font :: Iso' Font String
    _Font = iso getFont (Font . Last)

    instance AttributeClass Font

    -- | Extract the font family name from a @Font@ attribute.
    getFont :: Font -> String
    getFont (Font (Last f)) = f

    -- | Specify a font family to be used for all text within a diagram.
    font :: HasStyle a => String -> a -> a
    font = applyAttr . Font . Last

    -- | Lens onto the font name of a style.
    _font :: Lens' (Style v n) (Maybe String)
    _font = atAttr . mapping _Font

    --------------------------------------------------
    -- Font size

    -- | The @FontSize@ attribute specifies the size of a font's
    --   em-square.  Inner @FontSize@ attributes override outer ones.
    newtype FontSize n = FontSize (Recommend (Last n))
      deriving (Typeable, Semigroup)

    -- not sure why this can't be derived
    instance Functor FontSize where
      fmap f (FontSize (Recommend (Last a))) = FontSize (Recommend (Last (f a)))
      fmap f (FontSize (Commit (Last a)))    = FontSize (Commit (Last (f a)))

    _FontSize :: Iso' (FontSize n) (Recommend n)
    _FontSize = iso getter setter
      where getter (FontSize (Recommend (Last a))) = Recommend a
            getter (FontSize (Commit    (Last a))) = Commit a
            setter (Recommend a) = FontSize $ Recommend (Last a)
            setter (Commit    a) = FontSize $ Commit (Last a)
          -- = iso (\(FontSize a) -> a) FontSize . mapping _Wrapped
          -- once we depend on monoid-extras-0.4

    _FontSizeM :: Iso' (FontSizeM n) (Measured n (Recommend n))
    _FontSizeM = mapping _FontSize

    type FontSizeM n = Measured n (FontSize n)

    instance Typeable n => AttributeClass (FontSize n)

    instance Num n => Default (FontSizeM n) where
      def = FontSize . Recommend . Last <$> local 1

    -- | Extract the size from a @FontSize@ attribute.
    getFontSize :: FontSize n -> n
    getFontSize (FontSize (Recommend (Last s))) = s
    getFontSize (FontSize (Commit (Last s)))    = s

    -- | Set the font size, that is, the size of the font's em-square as
    --   measured within the current local vector space. The default size
    --   is @local 1@ (which is applied by 'recommendFontSize').
    fontSize :: (N a ~ n, Typeable n, HasStyle a) => Measure n -> a -> a
    fontSize = applyMAttr . fmap (FontSize . Commit . Last)

    -- | 'Recommend' a font size. Any use of 'fontSize' above this will
    --   overwrite any recommended size. This should only be used with
    --   'mkText'', other text functions already has a recommended font
    --   size so this will be ignored.
    recommendFontSize :: (N a ~ n, Typeable n, HasStyle a) => Measure n -> a -> a
    recommendFontSize = applyMAttr . fmap (FontSize . Recommend . Last)

    -- | A convenient synonym for 'fontSize (Global w)'.
    fontSizeG :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
    fontSizeG = fontSize . global

    -- | A convenient synonym for 'fontSize (Normalized w)'.
    fontSizeN :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
    fontSizeN = fontSize . normalized

    -- | A convenient synonym for 'fontSize (Output w)'.
    fontSizeO :: (N a ~ n, Typeable n, HasStyle a) => n -> a -> a
    fontSizeO = fontSize . output

    -- | A convenient sysnonym for 'fontSize (Local w)'.
    fontSizeL :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
    fontSizeL = fontSize . local

    -- | Apply a 'FontSize' attribute.
    fontSizeM :: (N a ~ n, Typeable n, HasStyle a) => FontSizeM n -> a -> a
    fontSizeM = applyMAttr

    _fontSizeR :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measured n (Recommend n))
    _fontSizeR = atMAttr . anon def (const False) . _FontSizeM

    -- | Lens to commit a font size. This is *not* a valid lens (see
    --   'commited'.
    _fontSize :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n)
    _fontSize = _fontSizeR . mapping committed

    _fontSizeU :: (Typeable n) => Lens' (Style v n) (Maybe n)
    _fontSizeU = atAttr . mapping (_FontSize . committed)

    --------------------------------------------------
    -- Font slant

    -- | The @FontSlantA@ attribute specifies the slant (normal, italic,
    --   or oblique) that should be used for all text within a diagram.
    --   Inner @FontSlantA@ attributes override outer ones.
    data FontSlant = FontSlantNormal
                   | FontSlantItalic
                   | FontSlantOblique
      deriving (Eq, Show, Typeable, Ord)

    instance AttributeClass FontSlant where
    instance Semigroup FontSlant where
      _ <> b = b

    instance Default FontSlant where
      def = FontSlantNormal

    -- | Extract the font slant from a 'FontSlantA' attribute.
    getFontSlant :: FontSlant -> FontSlant
    getFontSlant = id

    -- | Specify the slant (normal, italic, or oblique) that should be
    --   used for all text within a diagram.  See also 'italic' and
    --   'oblique' for useful special cases.
    fontSlant :: HasStyle a => FontSlant -> a -> a
    fontSlant = applyAttr

    -- | Lens onto the font slant in a style.
    _fontSlant :: Lens' (Style v n) FontSlant
    _fontSlant = atAttr . non def

    -- | Set all text in italics.
    italic :: HasStyle a => a -> a
    italic = fontSlant FontSlantItalic

    -- | Set all text using an oblique slant.
    oblique :: HasStyle a => a -> a
    oblique = fontSlant FontSlantOblique

    --------------------------------------------------
    -- Font weight

    -- | The @FontWeightA@ attribute specifies the weight (normal or bold)
    --   that should be used for all text within a diagram.  Inner
    --   @FontWeightA@ attributes override outer ones.
    data FontWeight = FontWeightNormal
                    | FontWeightBold
                    | FontWeightBolder
                    | FontWeightLighter
                    | FontWeightThin
                    | FontWeightUltraLight
                    | FontWeightLight
                    | FontWeightMedium
                    | FontWeightSemiBold
                    | FontWeightUltraBold
                    | FontWeightHeavy
        deriving (Eq,
                  Ord, Show, Typeable)

    instance AttributeClass FontWeight

    -- | Last semigroup structure
    instance Semigroup FontWeight where
      _ <> b = b

    instance Default FontWeight where
      def = FontWeightNormal

    -- | Extract the font weight.
    getFontWeight :: FontWeight -> FontWeight
    getFontWeight = id

    -- | Specify the weight (normal, bolder, lighter or bold) that should be
    --   used for all text within a diagram.  See also 'bold'
    --   for a useful special case.
    fontWeight :: HasStyle a => FontWeight -> a -> a
    fontWeight = applyAttr

    -- | Set all text using a bold font weight.
    bold :: HasStyle a => a -> a
    bold = fontWeight FontWeightBold

    -- | Set all text using a thin font weight.
    thinWeight :: HasStyle a => a -> a
    thinWeight = fontWeight FontWeightThin

    -- | Set all text using a extra light font weight.
    ultraLight :: HasStyle a => a -> a
    ultraLight = fontWeight FontWeightUltraLight

    -- | Set all text using a light font weight.
    light :: HasStyle a => a -> a
    light = fontWeight FontWeightLight

    -- | Set all text using a medium font weight.
    mediumWeight :: HasStyle a => a -> a
    mediumWeight = fontWeight FontWeightMedium

    -- | Set all text using a semi-bold font weight.
    semiBold :: HasStyle a => a -> a
    semiBold = fontWeight FontWeightSemiBold

    -- | Set all text using an ultra-bold font weight.
    ultraBold :: HasStyle a => a -> a
    ultraBold = fontWeight FontWeightUltraBold

    -- | Set all text using a heavy/black font weight.
    heavy :: HasStyle a => a -> a
    heavy = fontWeight FontWeightHeavy

    -- | Set all text to be bolder than the inherited font weight.
    bolder :: HasStyle a => a -> a
    bolder = fontWeight FontWeightBolder

    -- | Set all text to be lighter than the inherited font weight.
    lighter :: HasStyle a => a -> a
    lighter = fontWeight FontWeightLighter

    -- | Lens onto the font weight in a style.
    _fontWeight :: Lens' (Style v n) FontWeight
    _fontWeight = atAttr . non def