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

unlessM p x = p >>= flip unless x

syn f g h = f $ g <*> h

fromBinary path f = f =<< decodeFile path

fromBinaryList path f = mapM_ f =<< decodeFile path

synBinary path = syn (fromBinary path) (flip const) evaluate

synBinaryListToHT key path ht = syn (fromBinaryList path)
  (\x -> unlessM $ isJust <$> HT.lookup ht (key x)) (\x -> HT.insert ht (key x) x)

data User = User
  { _login :: !ByteString
  , _uid :: !Word
  , _gid :: !Word
  , _name :: !ByteString
  , _home :: !ByteString
  , _shell :: !ByteString
  } deriving ( Eq, Generic )
instance Binary User

synUsersToHTByName = synBinaryListToHT _name

test = do
  
  let root = User "root" 0 0 "root" "/root" "sh"
      user = User "user" 1 1 "user" "/user" "sh"
  
  encodeFile "/tmp/test1" root
  root' :: User <- synBinary "/tmp/test1"
  assert (root == root') $! return ()

  encodeFile "/tmp/test2" [root, user]
  ht :: BasicHashTable ByteString User <- HT.new
  synUsersToHTByName "/tmp/test2" ht
  root' <- HT.lookup ht "root"
  user' <- HT.lookup ht "user"
  assert (isJust root' && isJust user' && root == fromJust root' && user == fromJust user') $! return ()

unlessM p x = p >>= flip unless x

syn f g h = f $ g <*> h

fromBinary path f = f =<< decodeFile path

fromBinaryList path f = mapM_ f =<< decodeFile path

synBinary path = syn (fromBinary path) (flip const) return

synBinaryListToHT key path ht = syn (fromBinaryList path)
  (\x -> unlessM $ isJust <$> HT.lookup ht (key x)) (\x -> HT.insert ht (key x) x)

data User = User
  { _login :: !ByteString
  , _uid :: !Word
  , _gid :: !Word
  , _name :: !ByteString
  , _home :: !ByteString
  , _shell :: !ByteString
  } deriving ( Eq, Generic )
instance Binary User

synUsersToHTByName = synBinaryListToHT _name

test = do
  
  let root = User "root" 0 0 "root" "/root" "sh"
      user = User "user" 1 1 "user" "/user" "sh"
  
  encodeFile "/tmp/test1" root
  root' :: User <- synBinary "/tmp/test1"
  assert (root == root') $ return ()

  encodeFile "/tmp/test2" [root, user]
  ht :: BasicHashTable ByteString User <- HT.new
  synUsersToHTByName "/tmp/test2" ht
  root' <- HT.lookup ht "root"
  user' <- HT.lookup ht "user"
  assert (isJust root' && isJust user' && root == fromJust root' && user == fromJust user') $ return ()