{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE OverloadedStrings          #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Miso.OrphanInstances
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Orpthan instances for To/From MisoString instances for several
-- geometric types.
--
--------------------------------------------------------------------------------
module HGeometry.Miso.OrphanInstances
  () where

import           Data.Colour.SRGB (RGB(..))
import           Data.Fixed
import qualified Data.List as List
import           HGeometry.Matrix (Matrix)
import qualified Ipe as Ipe
import           Ipe.Color (IpeColor(..))
import           Ipe.Value
import           Miso.String (ToMisoString(..), FromMisoString(..))

--------------------------------------------------------------------------------

instance HasResolution p => ToMisoString (Fixed p) where
  toMisoString :: Fixed p -> MisoString
toMisoString = String -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (String -> MisoString)
-> (Fixed p -> String) -> Fixed p -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Fixed p -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True

instance HasResolution p => FromMisoString (Fixed p) where
  fromMisoStringEither :: MisoString -> Either String (Fixed p)
fromMisoStringEither = (Double -> Fixed p)
-> Either String Double -> Either String (Fixed p)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Fixed p
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Either String Double -> Either String (Fixed p))
-> (MisoString -> Either String Double)
-> MisoString
-> Either String (Fixed p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromMisoString t => MisoString -> Either String t
fromMisoStringEither @Double

instance ToMisoString Rational where
  toMisoString :: Rational -> MisoString
toMisoString = forall str. ToMisoString str => str -> MisoString
toMisoString @Pico (Pico -> MisoString)
-> (Rational -> Pico) -> Rational -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance FromMisoString Rational where
  fromMisoStringEither :: MisoString -> Either String Rational
fromMisoStringEither = (Pico -> Rational) -> Either String Pico -> Either String Rational
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pico -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Either String Pico -> Either String Rational)
-> (MisoString -> Either String Pico)
-> MisoString
-> Either String Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FromMisoString t => MisoString -> Either String t
fromMisoStringEither @Pico

instance ToMisoString r => ToMisoString (RGB r) where
  toMisoString :: RGB r -> MisoString
toMisoString (RGB r
r r
g r
b) = [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat [ MisoString
"rgb("
                                     , [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat ([MisoString] -> MisoString)
-> ([r] -> [MisoString]) -> [r] -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> [MisoString] -> [MisoString]
forall a. a -> [a] -> [a]
List.intersperse MisoString
" " ([MisoString] -> [MisoString])
-> ([r] -> [MisoString]) -> [r] -> [MisoString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> MisoString) -> [r] -> [MisoString]
forall a b. (a -> b) -> [a] -> [b]
map r -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([r] -> MisoString) -> [r] -> MisoString
forall a b. (a -> b) -> a -> b
$ [r
r,r
g,r
b]
                                     , MisoString
")"
                                     ]

--------------------------------------------------------------------------------
-- * Dealing with attributes

instance ToMisoString r => ToMisoString (IpeValue r) where
  toMisoString :: IpeValue r -> MisoString
toMisoString = \case
      Named MisoString
t  -> MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString MisoString
t
      Valued r
v -> r -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString r
v

instance ToMisoString r => ToMisoString (Ipe.IpePen r) where
  toMisoString :: IpePen r -> MisoString
toMisoString IpePen r
_ = MisoString
forall a. Monoid a => a
mempty

instance ToMisoString r => ToMisoString (Ipe.IpeSize r) where
  toMisoString :: IpeSize r -> MisoString
toMisoString IpeSize r
_ = MisoString
forall a. Monoid a => a
mempty

instance ToMisoString r => ToMisoString (Ipe.IpeArrow r) where
  toMisoString :: IpeArrow r -> MisoString
toMisoString IpeArrow r
_ = MisoString
forall a. Monoid a => a
mempty

instance ToMisoString r => ToMisoString (Ipe.IpeDash r) where
  toMisoString :: IpeDash r -> MisoString
toMisoString IpeDash r
_ = MisoString
forall a. Monoid a => a
mempty

instance ToMisoString r => ToMisoString (Matrix 3 3 r) where
  toMisoString :: Matrix 3 3 r -> MisoString
toMisoString Matrix 3 3 r
_ = MisoString
forall a. Monoid a => a
mempty

instance ToMisoString Ipe.FillType where
  toMisoString :: FillType -> MisoString
toMisoString FillType
_ = MisoString
forall a. Monoid a => a
mempty

instance ToMisoString Ipe.PinType where
  toMisoString :: PinType -> MisoString
toMisoString PinType
_ = MisoString
forall a. Monoid a => a
mempty

instance ToMisoString Ipe.TransformationTypes where
  toMisoString :: TransformationTypes -> MisoString
toMisoString TransformationTypes
_ = MisoString
forall a. Monoid a => a
mempty

instance ToMisoString r => ToMisoString (IpeColor r) where
  toMisoString :: IpeColor r -> MisoString
toMisoString (IpeColor IpeValue (RGB r)
c) = IpeValue (RGB r) -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString IpeValue (RGB r)
c

instance ToMisoString r => ToMisoString (Ipe.Path r) where
  toMisoString :: Path r -> MisoString
toMisoString Path r
_ = MisoString
forall a. Monoid a => a
mempty
    -- FIXME: This does not actually show the path

instance ToMisoString Ipe.LayerName where
  toMisoString :: LayerName -> MisoString
toMisoString (Ipe.LayerName MisoString
t) = MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString MisoString
t

instance FromMisoString Ipe.LayerName where
  fromMisoStringEither :: MisoString -> Either String LayerName
fromMisoStringEither = (MisoString -> LayerName)
-> Either String MisoString -> Either String LayerName
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MisoString -> LayerName
Ipe.LayerName (Either String MisoString -> Either String LayerName)
-> (MisoString -> Either String MisoString)
-> MisoString
-> Either String LayerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> Either String MisoString
forall t. FromMisoString t => MisoString -> Either String t
fromMisoStringEither


instance ToMisoString r => ToMisoString (Ipe.TextSizeUnit r) where
  toMisoString :: TextSizeUnit r -> MisoString
toMisoString (Ipe.TextSizeUnit r
x) = r -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString r
x

instance ToMisoString Ipe.VerticalAlignment where
  toMisoString :: VerticalAlignment -> MisoString
toMisoString = \case
    VerticalAlignment
Ipe.AlignTop      -> MisoString
"top"
    VerticalAlignment
Ipe.AlignVCenter  -> MisoString
"center"
    VerticalAlignment
Ipe.AlignBottom   -> MisoString
"bottom"
    VerticalAlignment
Ipe.AlignBaseline -> MisoString
"baseline"

instance ToMisoString Ipe.HorizontalAlignment where
  toMisoString :: HorizontalAlignment -> MisoString
toMisoString = \case
    HorizontalAlignment
Ipe.AlignLeft    -> MisoString
"left"
    HorizontalAlignment
Ipe.AlignHCenter -> MisoString
"center"
    HorizontalAlignment
Ipe.AlignRight   -> MisoString
"right"