Add more instances

This commit is contained in:
Anupam Jain 2021-01-21 16:19:06 +05:30
parent 5d6c4ca884
commit f76ab71f8c
2 changed files with 41 additions and 44 deletions

View File

@ -10,14 +10,17 @@ import Control.MonadPlus (class MonadPlus)
import Data.Array as A
import Data.CommutativeRing ((+))
import Data.Const (Const(..))
import Data.Either (Either(..))
import Data.Eq ((==))
import Data.Foldable (foldl)
import Data.Function (const, ($))
import Data.Identity (Identity(..))
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (unwrap)
import Data.Ordering (Ordering)
import Data.Tuple (Tuple(..))
import Data.Typeable (class Tag1, class Typeable, cast)
import Data.Typeable (class Tag0, class Tag1, class Typeable, cast)
import Data.Unit (Unit)
import Unsafe.Coerce (unsafeCoerce)
mkT :: forall a b. Typeable a => Typeable b => (b -> b) -> a -> a
@ -67,10 +70,6 @@ gfoldl :: forall a c. Data a => (forall d b. Data d => c (d -> b) -> d -> c b)
-- @c@ for the construction of the actual result type.
gfoldl = let DataDict f = dataDict in f
-- ((forall b. Data b => b -> b) -> a -> a)
-- (forall r. (forall b. Data b => b -> r) -> a -> Array r)
-- (forall m. (Monad m => (forall b. Data b => b -> m b) -> a -> m a))
class Typeable a <= Data a where
dataDict :: DataDict a
@ -214,17 +213,6 @@ unMp :: forall m x. Mp m x -> m (Tuple x Boolean)
unMp (Mp f) = f
{-
gmapT :: forall a. Data a => (forall b. Data b => b -> b) -> a -> a
gmapT = let DataDict f _ _ = dataDict in f
gmapQ :: forall a. Data a => forall r. (forall b. Data b => b -> r) -> a -> Array r
gmapQ = let DataDict _ f _ = dataDict in f
gmapM :: forall a. Data a => (forall m. Monad m => (forall b. Data b => b -> m b) -> a -> m a)
gmapM = let DataDict _ _ f = dataDict in f
-}
-- | Left-associative fold operation for constructor applications.
--
-- The type of 'gfoldl' is a headache, but operationally it is a simple
@ -234,40 +222,43 @@ gmapM = let DataDict _ _ f = dataDict in f
-- suitable for abstract datatypes with no substructures.
-- gfoldl
{-
-- Common instances
-- TODO: Why do we need `Tag0` here? Instead of `Typeable`.
instance dataArray :: (Tag0 a, Data a) => Data (Array a) where
dataDict = DataDict gmapT' gmapQ' gmapM'
where
gmapT' :: (forall b. Data b => b -> b) -> Array a -> Array a
gmapT' f arr = case A.uncons arr of
Nothing -> []
Just x -> A.cons (f x.head) (f x.tail)
gmapQ' :: forall r. (forall b. Data b => b -> r) -> Array a -> Array r
gmapQ' f arr = case A.uncons arr of
Nothing -> []
Just x -> [f x.head, f x.tail]
gmapM' :: forall m. (Monad m => (forall b. Data b => b -> m b) -> Array a -> m (Array a))
gmapM' f arr = case A.uncons arr of
Nothing -> pure []
Just x -> do
x' <- f x.head
xs' <- f x.tail
pure (A.cons x' xs')
dataDict = DataDict \k z arr -> case A.uncons arr of
Nothing -> z []
Just x -> (z A.cons `k` x.head) `k` x.tail
instance dataMaybe :: (Tag0 a, Data a) => Data (Maybe a) where
dataDict = DataDict \k z e -> case e of
Nothing -> z Nothing
Just a -> z Just `k` a
instance dataEither :: (Tag0 a, Tag0 b, Data a, Data b) => Data (Either a b) where
dataDict = DataDict \k z e -> case e of
Left a -> z Left `k` a
Right b -> z Right `k` b
instance dataBoolean :: Data Boolean where
dataDict = DataDict gmapT' gmapQ' gmapM'
where
gmapT' :: (forall b. Data b => b -> b) -> Boolean -> Boolean
gmapT' f x = x
gmapQ' :: forall r. (forall b. Data b => b -> r) -> Boolean -> Array r
gmapQ' f x = []
gmapM' :: forall m. (Monad m => (forall b. Data b => b -> m b) -> Boolean -> m Boolean)
gmapM' f x = pure x
dataDict = DataDict \k z x -> z x
-}
instance dataInt :: Data Int where
dataDict = DataDict \k z x -> z x
instance dataNumber :: Data Number where
dataDict = DataDict \k z x -> z x
instance dataChar :: Data Char where
dataDict = DataDict \k z x -> z x
instance dataString :: Data String where
dataDict = DataDict \k z x -> z x
instance dataUnit :: Data Unit where
dataDict = DataDict \k z x -> z x
instance dataOrdering :: Data Ordering where
dataDict = DataDict \k z x -> z x
-- Combinators

View File

@ -225,6 +225,9 @@ instance tag0Boolean :: Tag0 Boolean where
instance tag0Number :: Tag0 Number where
tag0 = proxy0
instance tag0Char :: Tag0 Char where
tag0 = proxy0
instance tag0String :: Tag0 String where
tag0 = proxy0
@ -234,6 +237,9 @@ instance tag0Unit :: Tag0 Unit where
instance taggedArray :: Tag1 Array where
tag1 = proxy1
instance taggedMaybe :: Tag1 Maybe where
tag1 = proxy1
instance tag2Func :: Tag2 (->) where
tag2 = proxy2