← All posts tagged code

hPutStr :: Handle -> BL.ByteString -> IO ()
hPutStr hdl lbs = wantWritableHandle "Data.ByteString.Lazy.hPutStr" hdl $ \hdl__ ->
  BL.foldrChunks (go hdl__) (commit hdl__) lbs
 where
  go hdl__ (S.PS ps s l) rest = do
   unless (l == 0) $ withForeignPtr ps $ \p -> do
    _ <- bufWrite hdl__ (p `plusPtr` s) l True
    pure ()
   rest
  commit hdl__ =
   case haBufferMode hdl__ of
    BlockBuffering _   -> do return ()
    _line_or_no_buffering -> do flushWriteBuffer hdl__
                  return ()

    ghc.EXE: unable to load package `text-icu-0.7.0.1'
    ghc.EXE: addLibrarySearchPath: C:\Users\****\backend\windows\deps\usr\local\lib (Win32 error 3): я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜.
    ghc.EXE: addLibrarySearchPath: C:\Users\****\backend\windows\deps\usr\local\lib (Win32 error 3): я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜.
    ghc.EXE: addLibrarySearchPath: C:\Users\****\backend\windows\deps\usr\local\lib (Win32 error 3): я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜.
    ghc.EXE: addLibrarySearchPath: C:\Users\****\backend\windows\deps\usr\local\lib (Win32 error 3): я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜я┐╜ я┐╜я┐╜я┐╜я┐╜.
    ghc.EXE: C:\sr\snapshots\7dd4ddea\lib\x86_64-windows-ghc-8.0.2\text-icu-0.7.0.1-JAtt4aKN3S2FwEv7rbv9x1\HStext-icu-0.7.0.1-JAtt4aKN3S2FwEv7rbv9x1.o: unknown symbol `ucnv_getMaxCharSize_57'

СПАСИБО ВИНДАВС Я ТАК И ПОНЯЛ, ЧТО ТЫ ГОВОРИШЬ ЧТО ПУТЬ НЕ ВЕРНЫЙ

amap :: (Category p, Strong p, Choice p, Profunctor p) => p a b -> p [a] [b]
amap = make . it . tasty where -- (p ||| amap p) where
  -- make :: Profunctor p => p (Either () (a,[a])) (Either () (b,[b])) -> p [a] [b]
  make = dimap view build
    where
     build = either (const []) (uncurry (:))
     view = maybe (Left ()) Right . uncons
  -- it :: (Choice p, Profunctor p) => p (a,[a]) (b,[b]) -> p (Either () (a,[a])) (Either () (b,[b]))
  it = right'
  -- tasty :: (Choice p, Category p, Strong p) => p a b -> p (a,[a]) (b,[b])
  tasty p = p ||| amap p
  (|||) x y = first' x >>> second' y

меняем it на right' и все перестает компилироваться, почему?

Prelude> let x = (id True, id undefined)
Prelude> :sprint x
x = _
Prelude> let x = (True, id undefined)
Prelude> :sprint x
x = _
Prelude> let x = (True, undefined)
Prelude> :sprint x
x = (,) True _
Prelude> let x = (True, undefined::Int)
Prelude> :sprint x
x = (True,_)
Prelude> let x = (True, False)
Prelude> :sprint x
x = (True,False)

кто-нить может мне объяснить почему вывод именно такой?

1.hs:46:44: error:
    • Could not deduce: q ~ (a0 -> q0)
      from the context: Cxq t q
        bound by the type signature for:
                   foo :: Cxq t q => V t -> [Def] -> [Val] -> q -> Exq t q
        at 1.hs:44:1-55
      or from: t ~ 'S a
        bound by a pattern with constructor:
                   :. :: forall (a :: S). String -> V a -> V ('S a),
                 in an equation for ‘foo’
        at 1.hs:46:6-12
      ‘q’ is a rigid type variable bound by
        the type signature for:
          foo :: forall (t :: S) q.
                 Cxq t q =>
                 V t -> [Def] -> [Val] -> q -> Exq t q
        at 1.hs:44:8
    • In the second argument of ‘(.)’, namely ‘q’
      In the first argument of ‘(=<<)’, namely ‘foo ss df vals . q’
      In the expression:
        foo ss df vals . q =<< fs =<< getValue s defs vals
    • Relevant bindings include
        q :: q (bound at 1.hs:46:23)
        foo :: V t -> [Def] -> [Val] -> q -> Exq t q (bound at 1.hs:45:1)


проблема т.к. у меня kind q зависит от значения (и типа) V t, если это V Z то kind *,  если V (S t) то * -> *.
это как-нить вообще обходится?

все что вам хотелось знать о жуйке:

wget -qO- http://api.juick.com/messages?tag=programming | runhaskell 1.hs  > programming.csv
wget -qO- http://api.juick.com/messages?tag=мж | runhaskell 1.hs  > mjo.csv


> p <- read.table("programming.csv",header=TRUE)


> summary(p)
         author     replies          likes
 qnikst     :9   Min.   : 0.00   Min.   :0.00
 SannySanoff:3   1st Qu.: 0.75   1st Qu.:0.00
 max630     :2   Median : 6.00   Median :0.00
 OCTAGRAM   :2   Mean   :11.15   Mean   :0.25
 drvlat     :1   3rd Qu.:10.25   3rd Qu.:0.00
 justonemore:1   Max.   :81.00   Max.   :2.00
 (Other)    :2

> mjo <- read.table("mjo.csv",header=TRUE)


> summary(mjo)
       author     replies           likes
 provaton :5   Min.   :  0.00   Min.   :0.0
 Monstreek:4   1st Qu.:  0.00   1st Qu.:0.0
 Bounty   :3   Median :  2.50   Median :0.0
 O01eg    :2   Mean   : 28.45   Mean   :0.2
 Strephil :2   3rd Qu.: 17.75   3rd Qu.:0.0
 lex2d    :1   Max.   :151.00   Max.   :1.0
 (Other)  :3

Есть плохая реализация fingerprint. Задача - придумать 2 разных типа, для которых fingerprint будет давать одинаковый результат:

 67 -- | The fingerprint of the typeRep of the argument
 68 fingerprint :: Typeable a => a -> Fingerprint
 69 fingerprint a =
 70     fingerprintFingerprints
 71       $ (fingerprintString $ module_ ++ "|" ++ name_)
 72       : map fingerprint args
 73   where
 74     tr = typeOf a
 75     (tycon, args) = splitTyConApp tr
 76     module_  = tyConModule tycon
 77     name_    = tyConName tycon


я точно знаю:
packageA:Foo.A
packageB:Foo.B

но есть ли что более интересное?

вот вопрос похоже исчерпан
```
{-# LANGUAGE TypeInType, GADTs, TypeFamilies, UndecidableInstances #-}
import Data.Kind (Type)

data N = Z | S N

data Fin :: N -> Type where
  FZ :: Fin (S n)
  FS :: Fin n -> Fin (S n)

type family FieldCount (t :: Type) :: N

type family FieldTypeI (t :: Type) (i :: N) :: Type
type family FieldType (t :: Type) (i :: Fin p) where
  FieldType t i = FieldTypeI t (F2II (AsQ t i))

type family AsQ (t :: Type) (i :: Fin n) :: Fin (FieldCount t) where
  AsQ t i = Cast (FieldCount t) i

type family Cast (t :: N) (i :: Fin n) :: Fin t where
  Cast (S Z) FZ = FZ
  Cast (S n) FZ = FZ
  Cast (S n) (FS k) = FS (Cast n k)


type family F2II (a :: Fin n) :: N where
  F2II (FS n) = S (F2II n)
  F2II FZ = Z

data T

type instance FieldCount T = S (S (S Z))
type instance FieldTypeI T Z = Int
type instance FieldTypeI T (S Z) = Bool
```

А сообщество уже придумало хороший обратно совместимый вариант решения:
```
src/Control/Distributed/Static.hs:479:1: warning: [-Wredundant-constraints]
    • Redundant constraints: (Typeable a, Typeable b, Typeable c)
    • In the type signature for:
           composeStatic :: (Typeable a, Typeable b, Typeable c) =>
                            Static ((b -> c) -> (a -> b) -> a -> c)
```

есть reify с помощью него я могу протаскивать словарики в инстансы, в которые через instance head их не протолкнуть. у меня есть например:

```
withAcquire
  :: forall m r.
     (MonadR m)
  => (forall s. Reifies s (AcquireIO (Region m)) => Proxy s -> m r)
  -> m r
withAcquire f = reify (AcquireIO (unsafeToIO . macquire)) f
  where
    macquire :: SEXP V a -> m (SEXP (Region m) a)
    macquire = acquire
```

я хочу теперь тоже самое но работающее в чистом коде (для чистовекторов)
вот каким чудом это сделать непонятно:

```
withGlobalAcquire :: (forall s t . Reifies s (AcquireIO t) => Proxy s -> ST t r) -> r
withGlobalAcquire f = ST.runST $ reify (AcquireIO acquireIO) f
  where
    acquireIO :: SEXP V ty -> IO (SEXP t ty)
    acquireIO x = do
      R.preserveObject x
      return $ R.unsafeRelease x
```

это работает, но есть проблема, что тип вектора определяется как ElemRep s v ty, т.к. у нас тут тип t из forall, то в итоге этот констрейнт нифига не добавить и что делать неясно

```
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
import Data.Typeable
import Data.Proxy
import Data.Void
import Unsafe.Coerce

data M a = M { mId :: Int, mData :: a}

data F = F (forall s. Typeable s => s -> IO ())

appF :: Typeable s => F -> s -> IO ()
appF (F f) = f

fPrint x = case cast x of
             Nothing -> return ()
             Just i  -> print (i :: Int)

fM x = case splitTyConApp (typeRep (px x)) of
         (tyCon,[t]) | tyCon == tyConM -> print (mId (unsafeCoerce x :: M Void))
         _ -> return ()
  where
    px :: x -> Proxy x
    px _ = Proxy
    (tyConM,_) = splitTyConApp (typeRep (Proxy :: Proxy (M Void)))
```
эту радость как-нить упростить можно? Задача, в том, по значению со Storabe словарём проверить, что это полиморфная штука `M a` и достать оттуда первое поле.

В одном проекте тут наткнулся на:
 
Helper macro creating an anonymous function with a given body.

For example:

@code
int foo(int x)
   {
           int y = x + 1;

	   bar(LAMBDA(int, (int z) { return z + y; }));
	   ...
   }
@endcode

Все ок если: нету свободных переменных, или только свободные переменные с статически известными адресами, иначе в kernel-space все плохо, в user-space все хорошо, где lamda не вызывается, когда функция где она опеделена выходит. 

Но все равно забавно.

а как создать такой же комадный интерфейс, который создает докер руками

```
6: docker0: <NO-CARRIER,BROADCAST,MULTICAST,UP> mtu 1500 qdisc noqueue state DOWN group default 
    link/ether 56:84:7a:fe:97:99 brd ff:ff:ff:ff:ff:ff
    inet 172.17.42.1/16 scope global docker0
       valid_lft forever preferred_lft forever
```

Проблема в следующем, я хочу, чтобы докер создавал listen сокет на этом интерфейсе, т.к. это позволяет изнутри контейнеров управлять докером, а пробрасывать unix socket в контейнеры мне лень.

Если я запускаю докер без "-H 172.17.42.1:5555" то он создает интерфейс, а при выключении не подчищает, поэтому вторым запуском я могу запустить докер с "-H 172.17.42.1:5555" и все будет работать. Но т.к. все в инитскриптах и менять руками настройки мне не хочется, поэтому я хочу создание интерфейса вытащить в start_pre и запускаться сразу с нужной опцией.