像replicateM一样复制A的方法？

Question

有:

getSdr = Sdr <$> u1 <*> u1 <*> u1 <*> getU1List <*> mcn <*> mcn?
             <*> mcn <*> mcn <*> mcn <*> mcn <*> mcn <*> mcn <*> mcn
             <*> mcn <*> mcn <*> mcn <*> mcn <*> mcn <*> mcn <*> mcn

想:

getSdr = Sdr <$> u1 <*> u1 <*> u1 <*> getU1List <*> replicateA 16 mcn

我注意到有replicateA,Data.Sequence但我不知道该库或它是否可以在这里帮助.它没有打字,因为它是

replicateA :: Applicative f => Int -> f a -> f (Seq a)

似乎没有逃脱 Seq

澄清一下,Sdr是一个记录:

   | Sdr { sdrHeadNum :: !U1
          , sdrSiteGrp :: !U1
          -- , siteCount :: !U1
          , siteNums :: [U1]
          , handlerType :: Maybe Text
          , handlerId :: Maybe Text
          , probeCardType :: Maybe Text
          , probeCardId :: Maybe Text
          , loadBoardType :: Maybe Text
          , loadBoardId :: Maybe Text
          , dibType :: Maybe Text
          , dibId :: Maybe Text
          , cableType :: Maybe Text
          , cableId :: Maybe Text
          , contactorType :: Maybe Text
          , contactorId :: Maybe Text
          , laserType :: Maybe Text
          , laserId :: Maybe Text
          , extraType :: Maybe Text
          , extraId :: Maybe Text }

它是所有数据类型的母亲的一部分:https://github.com/gitfoxi/Stdf/blob/WIP/Data/Stdf/Types.hs

Answer 1

这个答案需要疯狂的笑声.我不打算输出那部分; 你只需要想象一下.

在惯用的Haskell中你想要的是不可能的.你想要的可能是一个坏主意.但你想要的并不是完全不可能的.

第一个警告标志:我们需要大量的编译器扩展.我想,只有最后一个不是严格要求的.(这整个答案假设GHC 7.8;我认为它可以调整为7.6.)

{-# LANGUAGE TypeFamilies, DataKinds, MultiParamTypeClasses, 
    FlexibleInstances, ScopedTypeVariables, NoMonomorphismRestriction #-}
module Maniacal where
import Control.Applicative
import Data.Proxy

以疯狂的方式,我会先说清楚:

getSdr :: Applicative f => f Sdr
getSdr = Sdr <$> u1 <*> u1 <*> u1 <*> getU1List # starN sixteen mcn

ghci> getSdr :: [Sdr]
[Sdr A A A B C C C C C C C C C C C C C C C C]
ghci> :type starN sixteen mcn
{- something hideous -}

但是如何？!(Sdr顺便说一下,样板的样板定义是最底层的.)

首先,我们需要一个类型级别16,我们可以在递归类型类中使用它.(GHC的花式类型数字不支持7.8的归纳,在这里没用.)

data PInt = One | S PInt -- Promoted to types
type Sixteen = S (S (S (S (S (S (S (S (S (S (S (S (S (S (S One))))))))))))))
sixteen :: Proxy Sixteen
sixteen = Proxy

在大锅中我们抛出一个疯狂的类型.

class MultiStar (n :: PInt) a b where
  type MultiStarT n a b :: *
  starN :: Applicative f => proxy n -> f a -> f (MultiStarT n a b) -> f b

instance MultiStar One a b where
  type MultiStarT One a b = a -> b
  starN _ v f = f <*> v

instance (MultiStar n a b, (MultiStarT n a b) ~ (a -> t0))
       => MultiStar (S n) a b where
  type MultiStarT (S n) a b = a -> MultiStarT n a b
  starN _ v f = starN (Proxy :: Proxy n) v (addOne <$> f)
    where addOne g x = g x x

不要问我约束中的相等性.

最后,有点语法精确:

(#) = flip ($)
infixl 4 #

我们完成了!现在只是样板.(或者它应该是大锅？)和疯狂的笑声.

data A = A deriving Show
data B = B deriving Show
data C = C deriving Show
data Sdr = Sdr A A A B C C C C C C C C C C C C C C C C deriving Show
u1 = pure A
getU1List = pure B
mcn = pure C