← All posts tagged code

qnikst
? code Haskell lens
как в линзах адекватно написать слайс в двумерном неизменяемом векторе, у меня получилось:

под двухмерным вектором я понимаю `Vector (Vector a)`

v ^. sliced 1 2   - делает слайт вектора

over mapped (slice 1 2) (v ^. sliced 1 2) - делает все что мне надо, 
     но код так ужасен, поскольку часть слева от вектора, часть справа

(over mapped (slice 1 2) v) ^. sliced 1 2 - выглядит получше, но
     полущ но все равно ужасно

(v & mapped %~ (slice 1 2)) ^. sliced 1 2 - ещё лучше, теперь вектор слева, но 
     много смешных символов и скобок

v ^. sliced 1 2 & mapped %~ slice 1 2     -  уже почти по человекчески,
    но все равно плохо.

В итоге, как это правильно записывать, желательно используя только `slice` или только `sliced` и с минимумом прочего мусора. 
Вместо mapped я могу писать traversed или each с тем же результатом, так и задумано?
qnikst
code Haskell
rec let (v,m) = Map.insertLookupWithKey (\_ (m',r) _ -> (m',r+1)) pid (mref,1) hm
      mref <- maybe (monitor pid) (return . fst) v
return m

очень люблю такие штуки, тут мы в список вставляем значение, которое будет создано действием с эффектами в будущем в том случае, если оно нужно нам сейчас.
qnikst
? code Haskell хочется_странного
Усложняем странное третий раз (теперь даже без упрощения ситуации), пусть есть класс 

class ProtoBinary t  a where
   protoGet :: ByteString -> ProtoGet t a

есть приличный тип:

data B a where
   V :: a -> B a
   S :: IsProtocol p => ProtoGet p a -> ByteString -> B a

и хэлпер для её создания:

mkS :: forall proxy p a . (IsProtocol p, BondBinary p a) => proxy p -> ByteString -> Bonded a
mkS p bs = S (mkGet p) bs
    where mkGet :: proxy p -> BondGet p a 
          mkGet _ = bondGet


у меня есть функция 

withProtocol :: A -> B -> (forall t . IsProtocol t {- тут я могу напихать ещё констрейнтов -} => Proxy t -> b) 

использовать я её хочу в контексте:

foo = do
  a <- getA
  b <- getB
  bs <- getByteString
  return $ withProtocol a b $ \p -> mkS p bs

Естественно оно не создастся т.к. констрейнт BoundBinary p0 a взять неоткуда. 

Итак теперь самое важное, пусть у меня есть:

data Void

тогда если существует `instance ProtoBinary Void a`, то для любого p существует инстанс `ProtoBinary p a`, выражается ли это каким-либо человеческим способом в haskell? Можно ли этот способ выражения использовать для написания функции foo? 
qnikst
? code Haskell хочется_странного
Усложняем #2770717. Пусть есть класс:

class MyClass p where
    getVersion2 :: proxy p a -> Version
    getVersion1 :: proxy p    -> Version

хочу теперь "сжать" getVersion2 и getVersion1 в один метод, т.е. 
если меня есть GetM T1 a, или PutM T1 то я мог бы на них его вызвать.

qnikst
code Haskell concurrency
вот казалось бы простая задача, нужно изолировать поток,
в нём провести нужные операции и потом вернуться назад
все это кажется просто, но тут приходят они - асинхронные исключения,
и нужно, чтобы исключения приходящие во "wrapper" попадали в "worker".
В итоге получается треш и угар. Есть предложения по улушению?

callLocal ::
     Process a  -- ^ Process to run
  -> Process a  -- ^ Value returned
callLocal proc = mask $ \release -> do
  lock  <- liftIO $ newMVar ()
  tidMV <- liftIO $ newEmptyMVar
  mv    <- liftIO newEmptyMVar
  _ <- spawnLocal $ mask $ \release' -> do
         liftIO $ myThreadId >>= putMVar tidMV
         ep <- try $ release' $ proc <* liftIO (takeMVar lock)
         liftIO $ putMVar mv ep
  tid <- liftIO $ takeMVar tidMV
  let fetchResult =
        (takeMVar mv >>= either (throwIO :: SomeException -> IO a) return)
        `Exception.catch`
            (\e -> Exception.mask $ \release' -> do
                     ml <- tryTakeMVar lock
                     case ml of
                        Nothing -> -- lock already taked by worker so we need
                                   -- to rethrow exception now
                          throwIO e
                        Just{}  -> do
                          throwTo tid (e::SomeException)
                          putMVar lock ()
                     release' fetchResult)
  release $ liftIO $ fetchResult
qnikst
code Haskell typefun
Во какая доброта получилась, можно держать ядро программы
где требуется выполнение всяких требований и четко отделить его
от части программы где поступает вход от юзера, таким образом сразу видно, 
где и какие проверки требуются. Наверняка же ещё упростить можно?

> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE TypeOperators #-}
> {-# LANGUAGE ScopedTypeVariables #-}
> {-# LANGUAGE KindSignatures #-}
> {-# LANGUAGE ExistentialQuantification #-}
> {-# LANGUAGE ViewPatterns #-}
> {-# LANGUAGE PolyKinds #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE UndecidableInstances #-}
>
> import GHC.TypeLits
> import GHC.Exts 
> import Data.Proxy
> import System.Environment


> data Proof n  (c :: Constraint) where Proof :: Proxy n -> Proof n c

And runtime converter that checks constraint at runtime:

> fromSome :: SomeNat -> Maybe (Proof n (n <= 255))
> fromSome (SomeNat p)
>    | natVal p <= 255 = Just (Proof (Proxy :: Proxy n))
>    | otherwise = Nothing

> main :: IO ()
> main = do
>     [arg] <- getArgs
>     let n = read arg :: Integer
>
>     case someNatVal n of
>       Nothing -> error "Input is not a natural number!"
>       Just sn -> case fromSome sn of
>                    Just p -> return $ f2 p
>                    _ -> error "Input if larger than 255"
> 

> f2 :: (c ~ (n <= 255)) => Proof n c -> ()
> f2 _ = ()
qnikst
? code Haskell ghc
я правильно понимаю, что для того, чтобы в ghc сделать известный для компилятора тип из

data S where
   S :: R -> a -> S

нужно:

 staticSptEntryTyConName = mkWiredInTyConName UserSyntax
    gHC_STATICPTR (fsLit "S") staticSptEntryTyConKey staticSptEntryTyCon
тоже самое для DataConName

и собственно место где вопрос:

sDataCon :: DataCon
sDataCon =
    pcDataCon staticSptEntryDataConName [] [rTy, alphaTy] sTyCon

Собственно вопрос тут в alphaTy я ж правильно понимаю, что тут он?
qnikst
code Haskell typefun
смотрите какая классная штуковина:

{-# LANGUAGE GADTs #-}
import Data.Dependent.Map as D
import Data.GADT.Compare

import GHC.Generics

data Hint a where
  HintPort   :: Hint Int
  HintHost   :: Hint String
  HintTeapot :: Hint Int

instance GEq Hint where
  HintPort `geq` HintPort = Just Refl
  HintHost `geq` HintHost = Just Refl
  HintTeapot `geq` HintTeapot = Just Refl
  _ `geq` _ = Nothing

instance GCompare Hint where
  HintPort `gcompare` HintPort = GEQ
  HintHost `gcompare` HintHost = GEQ
  HintTeapot `gcompare` HintTeapot = GEQ
  HintPort `gcompare` HintHost = GGT
  HintPort `gcompare` HintTeapot = GGT
  HintHost `gcompare` HintTeapot = GGT
  a `gcompare` b = case b `gcompare` a of
                     GEQ -> GEQ
		     GGT -> GLT
		     GLT -> GGT

fibs = 1:1:zipWith (+) fibs (tail fibs)

test :: DMap Hint
test = D.insert HintTeapot 7 $ D.insert HintPort 99 $ D.insert HintPort 7 D.empty

и потом:

*Main> test ! HintPort
99
*Main> test ! HintTeapot
7
*Main> test ! HintHost
"*** Exception: DMap.find: element not in the map
*Main> HintHost `D.lookup` test
Nothing


ещё бы инстансы автоматом генерить (хотя это наверняка в либе есть)
qnikst
? code Haskell
Вот есть кусок кода весьма упрощенно:

bracket (connectTo ..) (hClose ..) $ \hdl -> someaction (\s -> hPut s ; hGet)

т.е. открываем соединение и функцию, использующую callback, который это соединение собственно и использует. Что хочется: в случае если соединение закрывается - то пересоздавать его.

Вопрос, как это сделать наибоее канонично? Я вижу вариант, с хранением hdl в IORef, но это как-то.. не круто. 
qnikst
? code Haskell
Внимание черный ящик!

-- safe, because this call might block
foreign import ccall safe "waitpid"
  c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid

getGroupProcessStatus :: Bool
                      -> Bool
                      -> ProcessGroupID
                      -> IO (Maybe (ProcessID, ProcessStatus))
getGroupProcessStatus block stopped pgid =
  alloca $ \wstatp -> do
    pid <- throwErrnoIfMinus1Retry "getGroupProcessStatus"
		(c_waitpid (-pgid) wstatp (waitOptions block stopped))
    case pid of
      0  -> return Nothing
      _  -> do ps <- readWaitStatus wstatp
	       return (Just (pid, ps))


getAnyProcessStatus :: Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus))
getAnyProcessStatus block stopped = getGroupProcessStatus block stopped 1

данная функция будучи запущенной без  WNOHANG   создаст же дополнительный OS Thread и будет в нём висеть?
qnikst
? code Haskell
import Data.Vector.VerySpecific as V
do
  let v = V.fromList [-1,-2,-3.0]
  liftIO $ Prelude.print v                -- (1)
  liftIO $ assertEquals "sdfsd" 3 (V.length v)

убираем (1) - тест проходит, добавляем - фейлится.
В коде много FFI, unsafeInlineIO и прочей черной магии,
а проблема в районе unsafeSlice, который меняет поле length в описании вектора.
Куда примерно копать? (минимальный код выделять не хотелось бы)
qnikst
? code Haskell печалька
а что так незя?

type I100 a = Tagged a Integer

(-+-) :: ((a + b) <= 100) => I100 a -> I100 b -> I100 (a + b)
(-+-) (Tagged a) (Tagged b) = Tagged (a+b)

f :: (a <= 50) => I100 a
f = Tagged 50

g :: (a <= 49) => I100 a
g = Tagged 49

d = f -+- g


Percent.hs:78:5:
    Couldn't match expected type ‘'True’ with actual type ‘a0 <=? 50’
    The type variable ‘a0’ is ambiguous
    Relevant bindings include
      d :: I100 (a0 + b0) (bound at Percent.hs:78:1)
    In the first argument of ‘(-+-)’, namely ‘f’
    In the expression: f -+- g
    In an equation for ‘d’: d = f -+- g

Percent.hs:78:7:
    Couldn't match expected type ‘'True’
                with actual type ‘(a0 + b0) <=? 100’
    The type variables ‘a0’, ‘b0’ are ambiguous
    Relevant bindings include
      d :: I100 (a0 + b0) (bound at Percent.hs:78:1)
    In the expression: f -+- g
    In an equation for ‘d’: d = f -+- g

Percent.hs:78:11:
    Couldn't match expected type ‘'True’ with actual type ‘b0 <=? 49’

qnikst
code Haskell
```
newtype EqSet = EqSet (IORef EqSet)

newset :: IO EqSet
newset = snd <$> (fixIO $ \ ~(_,x) -> do ira <- newIORef x
                                                                  return (ira, EqSet ira))
```

Даже не страшно такое писать, страшно, что оно работает..
qnikst
? code Haskell typefun
Помогите пожалуйста понять принцип работы forall с type families.
Ниже минимальный пример неработающего кода, интересует метод foo.
Особенно интересует то, что обозначает явное задание сигнатуры для 
foob в методе foo, с одной стороны FooE неинъективно и соотв компилятор не может выбрать конкретное foob, с другой a и b внесены под forall что должно быть подсказкой копилятору.
Я так понимаю данное поведение зависит от следующего, FooE это функция из a b в элементы с kind *, соотвественно если на момент определения инстанса вместо FooE a b подставляется результат вычисления FooE a b, то получается то поведение, что мы видим (тип b финкирован результатом), а 'a' не определено.
Если же редуцирования (?) не происходит, то тогда инстанс должен быть выбран.
Соответсвенно вопросы:
1. правильны ли те предположения, что я написал выше
2. куда почитать, чтобы подтвердить их или опровергнуть
3. это баг или фича

--
да, я знаю, что с data families все будет работать.


{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

class FooC a b where
  type FooE a b
  foob :: FooE a b -> b

foo :: forall a b . FooC a b => [FooE a b] -> b
foo = map (foob :: FooE a b -> b)

вывод:
3.hs:9:8:
    Could not deduce (FooE a0 b ~ FooE a b)
    from the context (FooC a b)
      bound by the type signature for foo :: FooC a b => [FooE a b] -> b
      at 3.hs:9:8-47
    NB: ‘FooE’ is a type function, and may not be injective
    The type variable ‘a0’ is ambiguous
    Expected type: [FooE a b] -> b
      Actual type: [FooE a0 b] -> b
qnikst
code Haskell хочется_странного typefun
есть

data HList :: [*] -> * where
  HNil :: HList '[]
  :>    :: t -> HList ts -> HList (t ': ts)

хочу написать тип:

data C t a b = forall s . <magic-here> => C !s (a -> s -> (b,s))

где <magic-here> должно обозначать следующее, каждый элемент в (HList s) должен быть элементом класса VectorSpace.

Напр запись <magic-here> VectorSpace t (HList s), будет говорить, что весь HList является VectorSpace, что в свою очередь будет обозначать что каждый элемент списка тоже VectorSpace..

В принципе есть хак, который мне не очень нравится, сделать

data HList :: * -> [*] -> * where
  HNil :: HList a '[]
  (:>) :: VectorSpace a t => t -> HList ts -> HList a (t':ts)

это классно сработает, но данное решение обозначает, что я не могу использовать HList из других либ и придётся таскать свой.
qnikst
? code Haskell хочется_странного
вот такая странная штука может получиться если пытаться писать
разложение в ряд тейлора и в принципе вычисления на них. Бонусом является то, что можно написать вычисления, а потом установить требуемую точность.
В общем забавные вычисления на бесконечных структурах данных.

Однако я был туп/ленив поэтому протупил со следующим:

1). все разложения производяться в окрестности 0, чтобы делать поддержку случайных мест нужно делать какой-то треш и угар с синглетонами, для того,
чтобы точка, в которой делается разложение хранилась в типе.

2). я был туп/ленив для того, чтобы написать умножение (кстати как на счет спецолимпиадки?)

3). естественно я не читал статей как это делать правильно

Теперь вопросы:

1). где найти инетересные статьи по решавшие аналогичный вопрос, хочется посмотреть как это сделать правильно

2). как решать, когда использовать Stream, а когда List? Поидее у первых плюсы, что можно сразу записать бесконечную структуру (что впрочем можно и со списком), а вот конечную адекватно не напишешь, если нету '0'?

{-# LANGUAGE BangPatterns #-}

data S a = S a (S a)

instance Functor S where
  fmap f (S a x) = S (f a) (fmap f x)

instance Num a => Num (S a) where
  (S a x) + (S b y) = S (a+b) (x+y)
  abs s = fmap abs s
  signum s = fmap signum s
  fromInteger x = S (fromInteger x) (fromInteger x)
  (*) = error "I'm too lazy/stupid"

instance Fractional a => Fractional (S a) where
  fromRational x = S (fromRational x) (fromRational x)

fromList :: [a] -> S a
fromList (x:xs) = S x (fromList xs) -- works only on infinite list

fromListNum :: Num a => [a] -> S a
fromListNum [] = 0
fromListNum (x:xs) = S x (fromListNum xs)

-- свертка
sfold :: (a -> b -> a) -> a -> S b -> S a
sfold f i (S x s) =
  let !k = f i x
  in S k (sfold f k s)

sfac :: (Enum a, Num a) => S a
sfac = sfold (*) 1 (fromList [1..]) 

sdfac :: Fractional a => S a
sdfac = fmap (\x -> 1 / (fromIntegral x)) sfac

(~*~) :: Num a => S a -> S a -> S a
(S a x) ~*~ S b y = S (a*b) (x ~*~ y)

ssum :: Num a => S a -> S a
ssum = sfold (+) 0

siterate :: (a -> a) -> a -> S a
siterate f x = S x (go x)
  where go !x = S (f x) (go (f x))

spower x = siterate (*x) x

-- | Build a serie of koeffs
--
--  k_n * x^n
--
build :: Fractional a => a -> S a -> S a
build t s = ssum $ spower t ~*~ s

suntil :: (a -> a -> Bool) -> S a -> a
suntil p (S a x@(S b y)) 
  | p a b = b
  | otherwise = suntil p x

eps :: (Ord a, Num a) => a -> S a -> a
eps e = suntil (\x y -> abs (x - y) < e)

-- | koefs T(exp)
texp :: Fractional a => S a
texp = S 1 sdfac

stake :: Int -> S a -> [a]
stake 0 _       = []
stake n (S a s) = a:stake (n-1) s

test1 = eps 0.05 $ build 1 texp