LINUX.ORG.RU

История изменений

Исправление qnikst, (текущая версия) :

маразм какой-то, ниже и то оверкил, т.к. под задачу в вакууме

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

data CB :: [*] -> * where
  Z :: CB '[]
  O :: a -> CB '[a]
  D :: a -> CB c -> CB (a ': c)

cbHead :: CB (a ': b) -> a
cbHead (O a) = a
cbHead (D a _) = a

cbTail :: CB (a ': b) -> CB b
cbTail (O a) = Z
cbTail (D _ t) = t

class HaveName a where getName :: a -> String
class HaveHeight a where getHeight :: a -> Int

data CN = CN String deriving (Show)
instance HaveName CN where getName (CN n) = n
data CNH = CNH String Int deriving (Show)
instance HaveName CNH where getName (CNH n _) = n
instance HaveHeight CNH where getHeight (CNH _ h) = h

test = D (CN "Vasya") (O (CNH "Kuzya " 5))

*Main> :t test
test :: CB '[CN, CNH]
*Main> cbHead test
CN "Vasya"
*Main> cbHead (cbTail test)
CNH "Kuzya " 5

Исходная версия qnikst, :

маразм какой-то, ниже и то оверкил, т.к. под задачу в вакууме

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

data CB :: [*] -> * where
  Z :: CB '[]
  O :: a -> CB '[a]
  D :: a -> CB c -> CB (a ': c)

cbHead :: CB (a ': b) -> a
cbHead (O a) = a
cbHead (D a _) = a

cbTail :: CB (a ': b) -> CB b
cbTail (O a) = Z
cbTail (D _ t) = t

class HaveName a where getName :: a -> String
class HaveHeight a where getHeight :: a -> Int

data CN = CN String deriving (Show)
instance HaveName CN where getName (CN n) = n
data CNH = CNH String Int deriving (Show)
instance HaveName CNH where getName (CNH n _) = n
instance HaveHeight CNH where getHeight (CNH _ h) = h

test = D (CN "Vasya") (O (CNH "Kuzya " 5))

*Main> :t test
test :: CB '[CN, CNH]
*Main> cbHead test
CN "Vasya"
*Main> cbHead (cbTail test)
CNH "Kuzya " 5