<commit_before>{-# LANGUAGE ConstraintKinds, DataKinds, KindSignatures, TypeApplications, TypeInType #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, InstanceSigs, MultiParamTypeClasses, NoMonomorphismRestriction, RankNTypes, TypeSynonymInstances, UndecidableInstances #-}
{-# LANGUAGE GADTs, TypeFamilies, TypeFamilyDependencies #-}
{-# LANGUAGE BangPatterns, MultiWayIf, OverloadedStrings, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeOperators #-}
{-# LANGUAGE DeriveFoldable, DeriveFunctor, DeriveGeneric, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall -Wno-unticked-promoted-constructors -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Flatland where

-- Basis
import           Prelude.Unicode

-- Type-level
import           GHC.Generics                             (Generic)
import           GHC.TypeLits
import           GHC.Types                         hiding (Constraint)

-- General types
import           Control.Applicative
import           Control.Applicative.Free
import           Control.Lens                      hiding (children)
import           Control.Monad.Random              hiding (lift)
import           Control.Monad.State               hiding (lift)
import           Data.Complex
import           Data.Function
import           Data.List
import           Data.Lub
import           Data.Maybe
import           Data.Glb
import           Data.MonoTraversable
import           Data.Monoid
import           Data.Text.Format
import qualified Data.Text.Format                  as T
import qualified Data.Text.Lazy                    as TL
import           Data.Type.Bool

-- Algebra
import           Linear                            hiding (trace)

-- glib-introspection -based Pango
import qualified GI.Pango                          as GIP (unitsToDouble, unitsFromDouble)

-- Misc
import           Debug.Trace                              (trace)
import           Text.PrettyPrint.Leijen.Text      hiding ((<>), (<$>), space)
import           Text.Printf                              (printf)

-- Dirty stuff
import qualified Foreign                           as F
import qualified System.IO.Unsafe                  as UN

-- Local
import           Elsewhere

import qualified Data.Map                          as Map



-- * Dimensional density.
newtype PΠ = PΠ { pπVal ∷ Double } deriving (Num, Show)
pπ ∷ PΠ
pπ = 72

newtype DΠ = DΠ { fromDΠ ∷ Double } deriving (Num, Show)

-- $Note [Pango resolution & unit conversion]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--   > Sets the resolution for the fontmap. This is a scale factor between
--   > points specified in a #PangoFontDescription and Cairo units. The
--   > default value is 96, meaning that a 10 point font will be 13
--   > units high. (10 * 96. / 72. = 13.3).
--   cited from: https://git.gnome.org/browse/pango/tree/pango/pangocairo-fontmap.c#n236
--   I.e.:
--     units  = points ⋅ dπ / pπ
--     points = units  / dπ ⋅ pπ
--
--   A good situation report is also at:
--     https://mail.gnome.org/archives/gtk-i18n-list/2002-May/msg00004.html
--
-- double pango_units_to_double   (int i)    { return (double)i / PANGO_SCALE; }
-- int    pango_units_from_double (double d) { return (int)floor (d * PANGO_SCALE + 0.5); }



-- * Universal, multi-density linear size.

data UnitK = PU | PUI | Pt | Ratio

type instance Element (Unit PU)    = Double
type instance Element (Unit PUI)   = F.Int32
type instance Element (Unit Pt)    = F.Int32
type instance Element (Unit Ratio) = Double

data Unit (u ∷ UnitK) where
  PUs    ∷ { fromPU    ∷ !(Element (Unit PU))    } → Unit PU    -- ^ Pango size, in device units -- aka pixels, as evidence overwhelmingly points to
  PUIs   ∷ { fromPUI   ∷ !(Element (Unit PUI))   } → Unit PUI   -- ^ Pango size, in device units, scaled by PANGO_SCALE
  Pts    ∷ { fromPt    ∷ !(Element (Unit Pt))    } → Unit Pt    -- ^ Pango size, in points (at 72ppi--see PΠ above--rate), device-agnostic
  PRatio ∷ { fromRatio ∷ !(Element (Unit Ratio)) } → Unit Ratio -- ^ Relative
type family UnitType a = r | r → a where
  UnitType (Unit PU)    = PU
  UnitType (Unit PUI)   = PUI
  UnitType (Unit Pt)    = Pt
  UnitType (Unit Ratio) = Ratio

-- <Boilerplate>
deriving instance Eq   (Unit u)
deriving instance Show (Unit u)
instance Fractional (Unit PU) where
  fromRational x = PUs $ fromRational x
  recip          = omap recip
instance Fractional (Unit Ratio) where
  fromRational x = PRatio $ fromRational x
  recip          = omap recip
instance MonoFunctor (Unit PU)    where omap f (PUs    x) = PUs    (f x)
instance MonoFunctor (Unit PUI)   where omap f (PUIs   x) = PUIs   (f x)
instance MonoFunctor (Unit Pt)    where omap f (Pts    x) = Pts    (f x)
instance MonoFunctor (Unit Ratio) where omap f (PRatio x) = PRatio (f x)
instance Ord (Unit PU)    where PUs    l <= PUs    r = l <= r
instance Ord (Unit PUI)   where PUIs   l <= PUIs   r = l <= r
instance Ord (Unit Pt)    where Pts    l <= Pts    r = l <= r
instance Ord (Unit Ratio) where PRatio l <= PRatio r = l <= r
instance Num (Unit PU)    where fromInteger = PUs    ∘ fromIntegral; PUs    x + PUs    y = PUs    $ x + y; PUs    x * PUs    y = PUs    $ x * y; abs = omap abs; signum = omap signum; negate = omap negate
instance Num (Unit PUI)   where fromInteger = PUIs   ∘ fromIntegral; PUIs   x + PUIs   y = PUIs   $ x + y; PUIs   x * PUIs   y = PUIs   $ x * y; abs = omap abs; signum = omap signum; negate = omap negate
instance Num (Unit Pt)    where fromInteger = Pts    ∘ fromIntegral; Pts    x + Pts    y = Pts    $ x + y; Pts    x * Pts    y = Pts    $ x * y; abs = omap abs; signum = omap signum; negate = omap negate
instance Num (Unit Ratio) where fromInteger = PRatio ∘ fromIntegral; PRatio x + PRatio y = PRatio $ x + y; PRatio x * PRatio y = PRatio $ x * y; abs = omap abs; signum = omap signum; negate = omap negate

instance Random (Unit PU) where
  randomR (PUs a, PUs a')   = runState $ liftA PUs $ state $ randomR (a, a')
  random                    = runState $ liftA PUs $ state random
instance Random (Unit PUI) where<commit_msg>flatland:  drop PRatio, add some instances<commit_after>{-# LANGUAGE ConstraintKinds, DataKinds, KindSignatures, TypeApplications, TypeInType #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, InstanceSigs, MultiParamTypeClasses, NoMonomorphismRestriction, RankNTypes, TypeSynonymInstances, UndecidableInstances #-}
{-# LANGUAGE GADTs, TypeFamilies, TypeFamilyDependencies #-}
{-# LANGUAGE BangPatterns, MultiWayIf, OverloadedStrings, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeOperators #-}
{-# LANGUAGE DeriveFoldable, DeriveFunctor, DeriveGeneric, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall -Wno-unticked-promoted-constructors -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Flatland where

-- Basis
import           Prelude.Unicode

-- Type-level
import           GHC.Generics                             (Generic)
import           GHC.TypeLits
import           GHC.Types                         hiding (Constraint)

-- General types
import           Control.Applicative
import           Control.Applicative.Free
import           Control.Lens                      hiding (children)
import           Control.Monad.Random              hiding (lift)
import           Control.Monad.State               hiding (lift)
import           Data.Complex
import           Data.Function
import           Data.List
import           Data.Lub
import           Data.Maybe
import           Data.Glb
import           Data.MonoTraversable
import           Data.Monoid
import           Data.Text.Format
import qualified Data.Text.Format                  as T
import qualified Data.Text.Lazy                    as TL
import           Data.Type.Bool

-- Algebra
import           Linear                            hiding (trace)

-- glib-introspection -based Pango
import qualified GI.Pango                          as GIP (unitsToDouble, unitsFromDouble)

-- Misc
import           Debug.Trace                              (trace)
import           Text.PrettyPrint.Leijen.Text      hiding ((<>), (<$>), space)
import           Text.Printf                              (printf)

-- Dirty stuff
import qualified Foreign                           as F
import qualified System.IO.Unsafe                  as UN

-- Local
import           Elsewhere

import qualified Data.Map                          as Map



-- * Dimensional density.
newtype PΠ = PΠ { pπVal ∷ Double } deriving (Num, Show)
pπ ∷ PΠ
pπ = 72

newtype DΠ = DΠ { fromDΠ ∷ Double } deriving (Eq, Num, Show)

-- $Note [Pango resolution & unit conversion]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--   > Sets the resolution for the fontmap. This is a scale factor between
--   > points specified in a #PangoFontDescription and Cairo units. The
--   > default value is 96, meaning that a 10 point font will be 13
--   > units high. (10 * 96. / 72. = 13.3).
--   cited from: https://git.gnome.org/browse/pango/tree/pango/pangocairo-fontmap.c#n236
--   I.e.:
--     units  = points ⋅ dπ / pπ
--     points = units  / dπ ⋅ pπ
--
--   A good situation report is also at:
--     https://mail.gnome.org/archives/gtk-i18n-list/2002-May/msg00004.html
--
-- double pango_units_to_double   (int i)    { return (double)i / PANGO_SCALE; }
-- int    pango_units_from_double (double d) { return (int)floor (d * PANGO_SCALE + 0.5); }



-- * Universal, multi-density linear size.

data UnitK = PU | PUI | Pt | Ratio

type instance Element (Unit PU)    = Double
type instance Element (Unit PUI)   = F.Int32
type instance Element (Unit Pt)    = F.Int32
type instance Element (Unit Ratio) = Double

data Unit (u ∷ UnitK) where
  PUs    ∷ { fromPU    ∷ !(Element (Unit PU))    } → Unit PU    -- ^ Pango size, in device units -- aka pixels, as evidence overwhelmingly points to
  PUIs   ∷ { fromPUI   ∷ !(Element (Unit PUI))   } → Unit PUI   -- ^ Pango size, in device units, scaled by PANGO_SCALE
  Pts    ∷ { fromPt    ∷ !(Element (Unit Pt))    } → Unit Pt    -- ^ Pango size, in points (at 72ppi--see PΠ above--rate), device-agnostic
type family UnitType a = r | r → a where
  UnitType (Unit PU)    = PU
  UnitType (Unit PUI)   = PUI
  UnitType (Unit Pt)    = Pt
  UnitType (Unit Ratio) = Ratio

-- <Boilerplate>
deriving instance Eq   (Unit u)
deriving instance Show (Unit u)
instance Fractional (Unit PU) where
  fromRational x = PUs $ fromRational x
  recip          = omap recip
instance MonoFunctor (Unit PU)    where omap f (PUs    x) = PUs    (f x)
instance MonoFunctor (Unit PUI)   where omap f (PUIs   x) = PUIs   (f x)
instance MonoFunctor (Unit Pt)    where omap f (Pts    x) = Pts    (f x)
instance Ord (Unit PU)    where PUs    l <= PUs    r = l <= r
instance Ord (Unit PUI)   where PUIs   l <= PUIs   r = l <= r
instance Ord (Unit Pt)    where Pts    l <= Pts    r = l <= r
instance Num (Unit PU)    where fromInteger = PUs    ∘ fromIntegral; PUs    x + PUs    y = PUs    $ x + y; PUs    x * PUs    y = PUs    $ x * y; abs = omap abs; signum = omap signum; negate = omap negate
instance Num (Unit PUI)   where fromInteger = PUIs   ∘ fromIntegral; PUIs   x + PUIs   y = PUIs   $ x + y; PUIs   x * PUIs   y = PUIs   $ x * y; abs = omap abs; signum = omap signum; negate = omap negate
instance Num (Unit Pt)    where fromInteger = Pts    ∘ fromIntegral; Pts    x + Pts    y = Pts    $ x + y; Pts    x * Pts    y = Pts    $ x * y; abs = omap abs; signum = omap signum; negate = omap negate

instance Random (Unit PU) where
  randomR (PUs a, PUs a')   = runState $ liftA PUs $ state $ randomR (a, a')
  random                    = runState $ liftA PUs $ state random
instance Random (Unit PUI) where
{'fraction_non_alphanumeric': 0.10363175675675676, 'fraction_numerical': 0.006587837837837838, 'mean_word_length': 2.2202882784878977, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 17, 'https://': 4, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5582773', 'n_tokens_mistral': 3992, 'n_tokens_neox': 3761, 'n_words': 1292}