GDP

Named.hs

module Named
  ( Named
  , type (~~)
  , name
  ) where

import Data.Coerce
import The

newtype Named name a = MkNamed a
type a ~~ name = Named name a

name :: a -> (forall name. (a ~~ name) -> k) -> k
name x k = k (coerce x)

instance The (a ~~ name') a

Sorted.hs

module Sorted
  ( Named
  , SortedBy
  , sortBy
  , mergeBy
  , test
  , smth
  ) where

import Data.Coerce
import Data.List qualified as List
import Data.List.Extra qualified as List
import Data.Map.Strict qualified as Map
import Data.Map.Justified qualified as J
import Named
import Pre hiding (use)
import The
import Data.List.Extra (upper)

newtype SortedBy comp a = MkSortedBy a

instance The (SortedBy comp a) a

sortBy :: ((a -> a -> Ordering) ~~ comp) -> List a -> SortedBy comp (List a)
sortBy comp xs = coerce (List.sortBy (the comp) xs)

mergeBy
  :: ((a -> a -> Ordering) ~~ comp)
  -> SortedBy comp (List a)
  -> SortedBy comp (List a)
  -> SortedBy comp (List a)
mergeBy comp xs ys = coerce (List.mergeBy (the comp) (the xs) (the ys))

-- type Digraph vs v = J.Map vs v (List (J.Key vs v))

test :: Map Int String
test = Map.fromList [(1, "hello"), (2, "world")]

smth :: IO ()
smth = J.withMap test \t -> case J.member 1 t of
  Nothing -> putStrLn "welp"
  Just k -> do
    let t' = J.reinsert k "howdy" t
    let t'' = upper <$> t
    putStrLn $ "map 1: " ++ J.lookup k t
    putStrLn $ "map 2: " ++ J.lookup k t'
    putStrLn $ "map 2: " ++ J.lookup k t''

The.hs

{-# LANGUAGE DefaultSignatures #-}

module The
  ( The (..)
  ) where

import Data.Coerce

class The d a | d -> a where
  the :: d -> a
  default the :: (Coercible d a) => d -> a
  the = coerce