Skip to content

Instantly share code, notes, and snippets.

@Lysxia

Lysxia/Scott0.hs

Created September 8, 2024 13:01
Show Gist options
  • Save Lysxia/4ca19f957ce6e50400fb0b15c53732ed to your computer and use it in GitHub Desktop.
Save Lysxia/4ca19f957ce6e50400fb0b15c53732ed to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. Lysxia created this gist Sep 8, 2024.
    74 changes: 74 additions & 0 deletions Scott0.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,74 @@
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE DefaultSignatures #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE EmptyCase #-}

    import GHC.Generics

    class GCase f a b where
    gCase :: f p -> a -> b

    instance GCase f a b => GCase (M1 i t f) a b where
    gCase (M1 x) = gCase x

    instance (GCase f a c, GCase g b c) => GCase (f :+: g) a (b -> c) where
    gCase (L1 x) = \a _ -> gCase x a
    gCase (R1 x) = \_ b -> gCase x b

    -- Before:
    -- instance (GCase f (a -> b -> c) a, GCase g (a -> b -> c) b) => GCase (f :*: g) (a -> b -> c) c where
    -- gCase (x :*: y) = \f -> f (gCase x f) (gCase y f)
    instance (GCase f a b, GCase g b c) => GCase (f :*: g) a c where
    gCase (f :*: g) = gCase @g @b @c g . gCase f

    -- Before:
    -- instance GCase U1 a a where
    instance (a ~ b) => GCase U1 a b where
    gCase U1 = id

    -- Before:
    -- instance Case c a b => GCase (K1 i c) a b where
    -- gCase (K1 x) = case' x
    --
    -- class Case a b c where
    -- case' :: a -> b -> c
    --
    -- instance Case c (c -> b) b where
    -- case' x k = k x
    instance (a ~ (c -> b)) => GCase (K1 i c) a b where
    gCase (K1 x) k = k x

    data Unit = Unit deriving (Show, Generic)
    data Bit = I | O deriving (Show, Generic)
    data Product = P Int Char deriving (Show, Generic)

    i1 :: Int
    i1 = 1


    main = do
    print $ ((gCase (from Unit) 'a')) -- 'a'
    print $ ((gCase (from Unit) i1) :: Int) -- 1
    print $ ((gCase (from I) 'a' 'b') :: Char) -- 'a'
    print $ ((gCase (from O) 'a' 'b') :: Char) -- 'b'
    print $ maybe' i1 (+i1) Nothing -- 1
    print $ maybe' i1 (+i1) (Just 1) -- 2
    print $ either' (show :: Char -> String) (show . (+i1)) (Left 'a') -- "'a'"
    print $ either' (show :: Char -> String) (show . (+i1)) (Right 10) -- 11
    -- Fixed
    print $ ((gCase (from (P 3 'a'))) (\(a :: Int) (b :: Char) -> (a, b))) -- (3, 'a')

    maybe' :: b -> (a -> b) -> Maybe a -> b
    maybe' def f x = gCase (from x) def f

    either' :: (a -> c) -> (b -> c) -> Either a b -> c
    either' r l x = gCase (from x) r l